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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.595   ! raeburn     4: # $Id: lonparmset.pm,v 1.594 2020/02/10 02:11:46 raeburn Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
1.579     raeburn    39: lonparmset provides an interface to setting content parameters in a 
                     40: course.
1.560     damieng    41: 
                     42: It contains all the code for the "Content and Problem Settings" UI, except
                     43: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
                     44: and lonblockingmenu.pm.
1.59      matthew    45: 
                     46: =head1 DESCRIPTION
                     47: 
                     48: This module sets coursewide and assessment parameters.
                     49: 
                     50: =head1 INTERNAL SUBROUTINES
                     51: 
1.416     jms        52: =over
1.59      matthew    53: 
1.416     jms        54: =item parmval()
1.59      matthew    55: 
                     56: Figure out a cascading parameter.
                     57: 
1.71      albertel   58: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   59:          $id   - a bighash Id number
1.71      albertel   60:          $def  - the resource's default value   'stupid emacs
                     61: 
1.556     raeburn    62: Returns:  A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71      albertel   63: 
1.556     raeburn    64: 18 - General Course
                     65: 17 - Map or Folder level in course (recursive) 
                     66: 16 - Map or Folder level in course (non-recursive)
                     67: 15 - resource default
                     68: 14 - map default
                     69: 13 - resource level in course
                     70: 12 - General for section
                     71: 11 - Map or Folder level for section (recursive)
                     72: 10 - Map or Folder level for section (non-recursive)
                     73: 9 - resource level in section
                     74: 8 - General for group
                     75: 7 - Map or Folder level for group (recursive)
                     76: 6 - Map or Folder level for group (non-recursive)
                     77: 5 - resource level in group
                     78: 4 - General for specific student
                     79: 3 - Map or Folder level for specific student (recursive)
                     80: 2 - Map or Folder level for specific student (non-recursive)
1.71      albertel   81: 1 - resource level for specific student
1.2       www        82: 
1.416     jms        83: =item parmval_by_symb()
                     84: 
                     85: =item reset_caches()
                     86: 
                     87: =item cacheparmhash() 
                     88: 
                     89: =item parmhash()
                     90: 
                     91: =item symbcache()
                     92: 
                     93: =item preset_defaults()
                     94: 
                     95: =item date_sanity_info()
                     96: 
                     97: =item storeparm()
                     98: 
                     99: Store a parameter by symb
                    100: 
                    101:     Takes
                    102:     - symb
                    103:     - name of parameter
                    104:     - level
                    105:     - new value
                    106:     - new type
                    107:     - username
                    108:     - userdomain
                    109: 
                    110: =item log_parmset()
                    111: 
                    112: =item storeparm_by_symb_inner()
                    113: 
                    114: =item valout()
                    115: 
                    116: Format a value for output.
                    117: 
                    118: Inputs:  $value, $type, $editable
                    119: 
                    120: Returns: $value, formatted for output.  If $type indicates it is a date,
                    121: localtime($value) is returned.
                    122: $editable will return an icon to click on
                    123: 
                    124: =item plink()
                    125: 
                    126: Produces a link anchor.
                    127: 
                    128: Inputs: $type,$dis,$value,$marker,$return,$call
                    129: 
                    130: Returns: scalar with html code for a link which will envoke the 
                    131: javascript function 'pjump'.
                    132: 
                    133: =item page_js()
                    134: 
                    135: =item startpage()
                    136: 
                    137: =item print_row()
                    138: 
                    139: =item print_td()
                    140: 
1.580     raeburn   141: =item check_other_groups()
1.416     jms       142: 
                    143: =item parm_control_group()
                    144: 
                    145: =item extractResourceInformation() : 
                    146: 
1.512     foxr      147:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       148: 
1.542     raeburn   149: Input: See list below
                    150: 
                    151: =over 4
1.416     jms       152: 
1.512     foxr      153: =item * B<env{'user.name'}> : Current username
1.416     jms       154: 
1.512     foxr      155: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       156: 
1.542     raeburn   157: =item * B<env{"request.course.fn"}> : Course
                    158: 
                    159: =back
1.416     jms       160: 
1.512     foxr      161: Outputs: See list below:
1.416     jms       162: 
1.542     raeburn   163: =over 4
                    164: 
1.512     foxr      165: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       166: 
1.512     foxr      167: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416     jms       168: 
1.512     foxr      169: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416     jms       170: 
1.512     foxr      171: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       172: 
1.512     foxr      173: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    174: 
                    175: =item * B<allmaps> (out) : hash, ???
1.416     jms       176: 
                    177: =item * B<mapp> : ??
                    178: 
                    179: =item * B<symbp> : hash, id->full sym?
                    180: 
1.512     foxr      181: =item * B<maptitles>
                    182: 
                    183: =item * B<uris>
1.416     jms       184: 
1.512     foxr      185: =item * B<keyorder>
                    186: 
                    187: =item * B<defkeytype>
1.416     jms       188: 
1.542     raeburn   189: =back
                    190: 
1.416     jms       191: =item isdateparm()
                    192: 
                    193: =item parmmenu()
                    194: 
                    195: =item partmenu()
                    196: 
                    197: =item usermenu()
                    198: 
                    199: =item displaymenu()
                    200: 
                    201: =item mapmenu()
                    202: 
                    203: =item levelmenu()
                    204: 
                    205: =item sectionmenu()
                    206: 
                    207: =item keysplit()
                    208: 
                    209: =item keysinorder()
                    210: 
                    211: =item keysinorder_bytype()
                    212: 
                    213: =item keysindisplayorder()
                    214: 
                    215: =item standardkeyorder()
                    216: 
                    217: =item assessparms() : 
                    218: 
                    219: Show assessment data and parameters.  This is a large routine that should
                    220: be simplified and shortened... someday.
                    221: 
1.513     foxr      222: Inputs: $r - the Apache request object.
                    223:   
1.416     jms       224: Returns: nothing
                    225: 
                    226: Variables used (guessed by Jeremy):
                    227: 
1.542     raeburn   228: =over
                    229: 
1.416     jms       230: =item * B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
                    231: 
                    232: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    233: 
                    234: =item * B<@catmarker> contains list of all possible parameters including part #s
                    235: 
                    236: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    237: 
                    238: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    239:         When storing information, store as part 0
                    240:         When requesting information, request from full part
                    241: 
1.542     raeburn   242: =back
                    243: 
1.416     jms       244: =item tablestart()
                    245: 
                    246: =item tableend()
                    247: 
                    248: =item extractuser()
                    249: 
                    250: =item parse_listdata_key()
                    251: 
                    252: =item listdata()
                    253: 
                    254: =item date_interval_selector()
                    255: 
                    256: =item get_date_interval_from_form()
                    257: 
                    258: =item default_selector()
                    259: 
                    260: =item string_selector()
                    261: 
                    262: =item dateshift()
                    263: 
                    264: =item newoverview()
                    265: 
                    266: =item secgroup_lister()
                    267: 
                    268: =item overview()
                    269: 
                    270: =item clean_parameters()
                    271: 
                    272: =item date_shift_one()
                    273: 
                    274: =item date_shift_two()
                    275: 
                    276: =item parse_key()
                    277: 
                    278: =item header()
                    279: 
                    280: Output html header for page
                    281: 
                    282: =item print_main_menu()
                    283: 
                    284: =item output_row()
                    285: 
                    286: Set portfolio metadata
                    287: 
                    288: =item order_meta_fields()
                    289: 
                    290: =item addmetafield()
                    291: 
                    292: =item setrestrictmeta()
                    293: 
                    294: =item get_added_meta_fieldnames()
                    295: 
                    296: =item get_deleted_meta_fieldnames()
                    297: 
                    298: =item defaultsetter()
                    299: 
                    300: =item components()
                    301: 
                    302: =item load_parameter_names()
                    303: 
                    304: =item parm_change_log()
                    305: 
                    306: =item handler() : 
                    307: 
1.450     raeburn   308: Main handler.  Calls &assessparms subroutine.
1.416     jms       309: 
                    310: =back
                    311: 
1.59      matthew   312: =cut
                    313: 
1.416     jms       314: ###################################################################
                    315: ###################################################################
                    316: 
                    317: package Apache::lonparmset;
                    318: 
                    319: use strict;
                    320: use Apache::lonnet;
                    321: use Apache::Constants qw(:common :http REDIRECT);
                    322: use Apache::lonhtmlcommon();
                    323: use Apache::loncommon;
                    324: use GDBM_File;
                    325: use Apache::lonhomework;
                    326: use Apache::lonxml;
                    327: use Apache::lonlocal;
                    328: use Apache::lonnavmaps;
                    329: use Apache::longroup;
                    330: use Apache::lonrss;
1.506     www       331: use HTML::Entities;
1.416     jms       332: use LONCAPA qw(:DEFAULT :match);
                    333: 
                    334: 
1.560     damieng   335: ##################################################
                    336: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
                    337: ##################################################
                    338: 
                    339: # Page header
1.561     damieng   340: #
                    341: # @param {Apache2::RequestRec} $r - Apache request object
                    342: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
                    343: # @param {string} $crstype - course type ('Community' for community settings)
1.507     www       344: sub startSettingsScreen {
1.531     raeburn   345:     my ($r,$mode,$crstype)=@_;
1.507     www       346: 
1.531     raeburn   347:     my $tabtext = &mt('Course Settings');
                    348:     if ($crstype eq 'Community') {
                    349:         $tabtext = &mt('Community Settings');
                    350:     } 
1.507     www       351:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
                    352:     $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.531     raeburn   353:                                           $tabtext.
1.507     www       354:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    355: 
1.523     raeburn   356:     $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507     www       357:                                                                  &mt('Content and Problem Settings').'</b></a></li>');
                    358:     $r->print("\n".'</ul>'."\n");
1.523     raeburn   359:     $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507     www       360: }
                    361: 
1.560     damieng   362: # Page footer
1.507     www       363: sub endSettingsScreen {
                    364:    my ($r)=@_;
                    365:    $r->print('</div></div></div>');
                    366: }
                    367: 
                    368: 
                    369: 
1.560     damieng   370: ##################################################
1.563     damieng   371: # (mostly) TABLE MODE
1.560     damieng   372: # (parmval is also used for the log of parameter changes)
                    373: ##################################################
                    374: 
1.566     damieng   375: # Calls parmval_by_symb, getting the symb from $id with &symbcache.
1.561     damieng   376: #
                    377: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   378: # @param {string} $id - resource id or map pc
1.561     damieng   379: # @param {string} $def - the resource's default value for this parameter
                    380: # @param {string} $uname - user name
                    381: # @param {string} $udom - user domain
                    382: # @param {string} $csec - section name
                    383: # @param {string} $cgroup - group name
                    384: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    385: # @returns {Array}
1.2       www       386: sub parmval {
1.275     raeburn   387:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    388:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    389:                                                            $cgroup,$courseopt);
1.201     www       390: }
                    391: 
1.561     damieng   392: # Returns an array containing
                    393: # - the most specific level that is defined for that parameter (integer)
                    394: # - an array with the level as index and the parameter value as value (when defined)
                    395: #   (level 1 is the most specific and will have precedence)
                    396: #
                    397: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   398: # @param {string} $symb - resource symb or map src
1.561     damieng   399: # @param {string} $def - the resource's default value for this parameter
                    400: # @param {string} $uname - user name
                    401: # @param {string} $udom - user domain
                    402: # @param {string} $csec - section name
                    403: # @param {string} $cgroup - group name
                    404: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    405: # @returns {Array}
1.201     www       406: sub parmval_by_symb {
1.275     raeburn   407:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       408: 
1.352     albertel  409:     my $useropt;
                    410:     if ($uname ne '' && $udom ne '') {
1.561     damieng   411:         $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  412:     }
1.200     www       413: 
1.8       www       414:     my $result='';
1.44      albertel  415:     my @outpar=();
1.2       www       416: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    417:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  418:     $map = &Apache::lonnet::deversion($map);
1.561     damieng   419:     
                    420:     # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
                    421:     # any change should be reflected there.
                    422:     
1.201     www       423:     my $symbparm=$symb.'.'.$what;
1.556     raeburn   424:     my $recurseparm=$map.'___(rec).'.$what; 
1.201     www       425:     my $mapparm=$map.'___(all).'.$what;
1.10      www       426: 
1.269     raeburn   427:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    428:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   429:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   430:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    431: 
1.190     albertel  432:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    433:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   434:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  435:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    436: 
                    437:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    438:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   439:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  440:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       441: 
1.11      www       442: 
1.182     albertel  443: # --------------------------------------------------------- first, check course
1.11      www       444: 
1.561     damieng   445: # 18 - General Course
1.200     www       446:     if (defined($$courseopt{$courselevel})) {
1.556     raeburn   447:         $outpar[18]=$$courseopt{$courselevel};
                    448:         $result=18;
                    449:     }
                    450: 
1.561     damieng   451: # 17 - Map or Folder level in course (recursive) 
1.556     raeburn   452:     if (defined($$courseopt{$courseleveli})) {
                    453:         $outpar[17]=$$courseopt{$courseleveli};
                    454:         $result=17;
1.43      albertel  455:     }
1.11      www       456: 
1.561     damieng   457: # 16 - Map or Folder level in course (non-recursive)
1.200     www       458:     if (defined($$courseopt{$courselevelm})) {
1.556     raeburn   459:         $outpar[16]=$$courseopt{$courselevelm};
                    460:         $result=16;
1.43      albertel  461:     }
1.11      www       462: 
1.182     albertel  463: # ------------------------------------------------------- second, check default
                    464: 
1.561     damieng   465: # 15 - resource default
1.556     raeburn   466:     if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182     albertel  467: 
                    468: # ------------------------------------------------------ third, check map parms
                    469: 
1.556     raeburn   470:     
1.561     damieng   471: # 14 - map default
1.376     albertel  472:     my $thisparm=&parmhash($symbparm);
1.556     raeburn   473:     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182     albertel  474: 
1.561     damieng   475: # 13 - resource level in course
1.200     www       476:     if (defined($$courseopt{$courselevelr})) {
1.556     raeburn   477:         $outpar[13]=$$courseopt{$courselevelr};
                    478:         $result=13;
1.43      albertel  479:     }
1.11      www       480: 
1.182     albertel  481: # ------------------------------------------------------ fourth, back to course
1.352     albertel  482:     if ($csec ne '') {
1.561     damieng   483: # 12 - General for section
1.200     www       484:         if (defined($$courseopt{$seclevel})) {
1.556     raeburn   485:             $outpar[12]=$$courseopt{$seclevel};
                    486:             $result=12;
                    487:         }
1.561     damieng   488: # 11 - Map or Folder level for section (recursive)
1.556     raeburn   489:         if (defined($$courseopt{$secleveli})) {
                    490:             $outpar[11]=$$courseopt{$secleveli};
                    491:             $result=11;
                    492:         }
1.561     damieng   493: # 10 - Map or Folder level for section (non-recursive)
1.200     www       494:         if (defined($$courseopt{$seclevelm})) {
1.556     raeburn   495:             $outpar[10]=$$courseopt{$seclevelm};
                    496:             $result=10;
                    497:         }
1.561     damieng   498: # 9 - resource level in section
1.200     www       499:         if (defined($$courseopt{$seclevelr})) {
1.556     raeburn   500:             $outpar[9]=$$courseopt{$seclevelr};
                    501:             $result=9;
                    502:         }
1.43      albertel  503:     }
1.275     raeburn   504: # ------------------------------------------------------ fifth, check course group
1.352     albertel  505:     if ($cgroup ne '') {
1.561     damieng   506: # 8 - General for group
1.269     raeburn   507:         if (defined($$courseopt{$grplevel})) {
1.556     raeburn   508:             $outpar[8]=$$courseopt{$grplevel};
                    509:             $result=8;
                    510:         }
1.561     damieng   511: # 7 - Map or Folder level for group (recursive)
1.556     raeburn   512:         if (defined($$courseopt{$grpleveli})) {
                    513:             $outpar[7]=$$courseopt{$grpleveli};
                    514:             $result=7;
1.269     raeburn   515:         }
1.561     damieng   516: # 6 - Map or Folder level for group (non-recursive)
1.269     raeburn   517:         if (defined($$courseopt{$grplevelm})) {
1.556     raeburn   518:             $outpar[6]=$$courseopt{$grplevelm};
                    519:             $result=6;
1.269     raeburn   520:         }
1.561     damieng   521: # 5 - resource level in group
1.269     raeburn   522:         if (defined($$courseopt{$grplevelr})) {
1.556     raeburn   523:             $outpar[5]=$$courseopt{$grplevelr};
                    524:             $result=5;
1.269     raeburn   525:         }
                    526:     }
1.11      www       527: 
1.556     raeburn   528: # ---------------------------------------------------------- sixth, check user
1.11      www       529: 
1.352     albertel  530:     if ($uname ne '') {
1.561     damieng   531: # 4 - General for specific student
                    532:         if (defined($$useropt{$courselevel})) {
                    533:             $outpar[4]=$$useropt{$courselevel};
                    534:             $result=4;
                    535:         }
1.556     raeburn   536: 
1.561     damieng   537: # 3 - Map or Folder level for specific student (recursive)
                    538:         if (defined($$useropt{$courseleveli})) {
                    539:             $outpar[3]=$$useropt{$courseleveli};
                    540:             $result=3;
                    541:         }
1.473     amueller  542: 
1.561     damieng   543: # 2 - Map or Folder level for specific student (non-recursive)
                    544:         if (defined($$useropt{$courselevelm})) {
                    545:             $outpar[2]=$$useropt{$courselevelm};
                    546:             $result=2;
                    547:         }
1.473     amueller  548: 
1.561     damieng   549: # 1 - resource level for specific student
                    550:         if (defined($$useropt{$courselevelr})) {
                    551:             $outpar[1]=$$useropt{$courselevelr};
                    552:             $result=1;
                    553:         }
1.43      albertel  554:     }
1.44      albertel  555:     return ($result,@outpar);
1.2       www       556: }
                    557: 
1.198     www       558: 
                    559: 
1.376     albertel  560: # --- Caches local to lonparmset
                    561: 
1.446     bisitz    562: 
1.561     damieng   563: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376     albertel  564: sub reset_caches {
                    565:     &resetparmhash();
                    566:     &resetsymbcache();
                    567:     &resetrulescache();
1.203     www       568: }
                    569: 
1.561     damieng   570: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
                    571: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376     albertel  572: {
1.561     damieng   573:     my $parmhashid; # course identifier, to initialize the cache only once for a course
                    574:     my %parmhash; # the parameter cache
                    575:     # reset map parameter hash
1.376     albertel  576:     sub resetparmhash {
1.560     damieng   577:         undef($parmhashid);
                    578:         undef(%parmhash);
1.376     albertel  579:     }
1.446     bisitz    580: 
1.561     damieng   581:     # dump the _parms.db database into %parmhash
1.376     albertel  582:     sub cacheparmhash {
1.560     damieng   583:         if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    584:         my %parmhashfile;
                    585:         if (tie(%parmhashfile,'GDBM_File',
                    586:             $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    587:             %parmhash=%parmhashfile;
                    588:             untie(%parmhashfile);
                    589:             $parmhashid=$env{'request.course.fn'};
                    590:         }
1.201     www       591:     }
1.446     bisitz    592: 
1.561     damieng   593:     # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376     albertel  594:     sub parmhash {
1.560     damieng   595:         my ($id) = @_;
                    596:         &cacheparmhash();
                    597:         return $parmhash{$id};
1.376     albertel  598:     }
1.560     damieng   599: }
1.376     albertel  600: 
1.566     damieng   601: # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
1.446     bisitz    602: {
1.561     damieng   603:     my $symbsid; # course identifier, to initialize the cache only once for a course
                    604:     my %symbs; # hash id->symb
                    605:     # reset the id->symb cache
1.376     albertel  606:     sub resetsymbcache {
1.560     damieng   607:         undef($symbsid);
                    608:         undef(%symbs);
1.376     albertel  609:     }
1.446     bisitz    610: 
1.566     damieng   611:     # returns the resource symb or map src corresponding to a resource id or map pc
                    612:     # (using lonnavmaps and a cache)
1.376     albertel  613:     sub symbcache {
1.560     damieng   614:         my $id=shift;
                    615:         if ($symbsid ne $env{'request.course.id'}) {
                    616:             undef(%symbs);
                    617:         }
                    618:         if (!$symbs{$id}) {
                    619:             my $navmap = Apache::lonnavmaps::navmap->new();
                    620:             if ($id=~/\./) {
                    621:                 my $resource=$navmap->getById($id);
                    622:                 $symbs{$id}=$resource->symb();
                    623:             } else {
                    624:                 my $resource=$navmap->getByMapPc($id);
                    625:                 $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    626:             }
                    627:             $symbsid=$env{'request.course.id'};
1.473     amueller  628:         }
1.560     damieng   629:         return $symbs{$id};
1.473     amueller  630:     }
1.560     damieng   631: }
1.201     www       632: 
1.561     damieng   633: # cache for parameter default actions (stored in parmdefactions.db)
1.446     bisitz    634: {
1.561     damieng   635:     my $rulesid; # course identifier, to initialize the cache only once for a course
                    636:     my %rules; # parameter default actions hash
1.376     albertel  637:     sub resetrulescache {
1.560     damieng   638:         undef($rulesid);
                    639:         undef(%rules);
1.376     albertel  640:     }
1.446     bisitz    641: 
1.561     damieng   642:     # returns the value for a given key in the parameter default action hash
1.376     albertel  643:     sub rulescache {
1.560     damieng   644:         my $id=shift;
                    645:         if ($rulesid ne $env{'request.course.id'}
                    646:             && !defined($rules{$id})) {
                    647:             my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    648:             my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    649:             %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    650:             $rulesid=$env{'request.course.id'};
                    651:         }
                    652:         return $rules{$id};
1.221     www       653:     }
                    654: }
                    655: 
1.416     jms       656: 
1.561     damieng   657: # Returns the values of the parameter type default action
                    658: # "default value when manually setting".
                    659: # If none is defined, ('','','','','') is returned.
                    660: #
                    661: # @param {string} $type - parameter type
                    662: # @returns {Array<string>} - (hours, min, sec, value)
1.229     www       663: sub preset_defaults {
                    664:     my $type=shift;
                    665:     if (&rulescache($type.'_action') eq 'default') {
1.560     damieng   666:         # yes, there is something
                    667:         return (&rulescache($type.'_hours'),
                    668:             &rulescache($type.'_min'),
                    669:             &rulescache($type.'_sec'),
                    670:             &rulescache($type.'_value'));
1.229     www       671:     } else {
1.560     damieng   672:         # nothing there or something else
                    673:         return ('','','','','');
1.229     www       674:     }
                    675: }
                    676: 
1.416     jms       677: 
1.561     damieng   678: # Checks that a date is after enrollment start date and before
                    679: # enrollment end date.
                    680: # Returns HTML with a warning if it is not, or the empty string otherwise.
                    681: # This is used by both overview and table modes.
                    682: #
                    683: # @param {integer} $checkdate - the date to check.
                    684: # @returns {string} - HTML possibly containing a localized warning message.
1.277     www       685: sub date_sanity_info {
                    686:    my $checkdate=shift;
                    687:    unless ($checkdate) { return ''; }
                    688:    my $result='';
                    689:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    690:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    691:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    692:          $result.='<div class="LC_warning">'
                    693:                  .&mt('After course enrollment end!')
                    694:                  .'</div>';
1.277     www       695:       }
                    696:    }
                    697:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    698:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    699:          $result.='<div class="LC_warning">'
                    700:                  .&mt('Before course enrollment start!')
                    701:                  .'</div>';
1.277     www       702:       }
                    703:    }
1.413     bisitz    704: # Preparation for additional warnings about dates in the past/future.
                    705: # An improved, more context sensitive version is recommended,
                    706: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    707: #   if ($checkdate<time) {
                    708: #      $result.='<div class="LC_info">'
                    709: #              .'('.&mt('in the past').')'
                    710: #              .'</div>';
                    711: #      }
                    712: #   if ($checkdate>time) {
                    713: #      $result.='<div class="LC_info">'
                    714: #              .'('.&mt('in the future').')'
                    715: #              .'</div>';
                    716: #      }
1.277     www       717:    return $result;
                    718: }
1.561     damieng   719: 
                    720: 
                    721: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186     www       722: #
1.566     damieng   723: # @param {string} $sresid - resource id or map pc
1.565     damieng   724: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   725: # @param {integer} $snum - level
                    726: # @param {string} $nval - new value
                    727: # @param {string} $ntype - new type
                    728: # @param {string} $uname - username
                    729: # @param {string} $udom - userdomain
                    730: # @param {string} $csec - section name
                    731: # @param {string} $cgroup - group name
1.186     www       732: sub storeparm {
1.269     raeburn   733:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   734:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       735: }
                    736: 
1.561     damieng   737: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
                    738: 
                    739: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
                    740: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
                    741: #
1.566     damieng   742: # @param {string} $symb - resource symb or map src
1.565     damieng   743: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   744: # @param {integer} $snum - level
                    745: # @param {string} $nval - new value
                    746: # @param {string} $ntype - new type
                    747: # @param {string} $uname - username
                    748: # @param {string} $udom - userdomain
                    749: # @param {string} $csec - section name
                    750: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
                    751: # @param {string} $cgroup - group name
1.197     www       752: sub storeparm_by_symb {
1.275     raeburn   753:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       754:     unless ($recflag) {
1.560     damieng   755:         # first time call
                    756:         %recstack=();
                    757:         $recflag=1;
1.226     www       758:     }
1.560     damieng   759:     # store parameter
1.226     www       760:     &storeparm_by_symb_inner
1.473     amueller  761:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560     damieng   762:     # don't do anything if parameter was reset
1.266     www       763:     unless ($nval) { return; }
1.226     www       764:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560     damieng   765:     # remember that this was set
1.226     www       766:     $recstack{$parm}=1;
1.560     damieng   767:     # what does this trigger?
1.226     www       768:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560     damieng   769:         # don't backfire
                    770:         unless ((!$triggered) || ($recstack{$triggered})) {
                    771:             my $action=&rulescache($triggered.'_action');
                    772:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    773:             # set triggered parameter on same level
                    774:             my $newspnam=$prefix.$triggered;
                    775:             my $newvalue='';
                    776:             my $active=1;
                    777:             if ($action=~/^when\_setting/) {
                    778:             # are there restrictions?
                    779:                 if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    780:                     $active=0;
1.565     damieng   781:                     foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560     damieng   782:                         if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    783:                     }
                    784:                 }
                    785:                 $newvalue=&rulescache($triggered.'_value');
                    786:             } else {
                    787:                 my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    788:                 if ($action=~/^later\_than/) {
                    789:                     $newvalue=$nval+$totalsecs;
                    790:                 } else {
                    791:                     $newvalue=$nval-$totalsecs;
                    792:                 }
                    793:             }
                    794:             if ($active) {
                    795:                 &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    796:                         $uname,$udom,$csec,$recflag,$cgroup);
                    797:             }
                    798:         }
1.226     www       799:     }
                    800:     return '';
                    801: }
                    802: 
1.561     damieng   803: # Adds all given arguments to the course parameter log.
                    804: # @returns {string} - the answer to the lonnet query.
1.293     www       805: sub log_parmset {
1.525     raeburn   806:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       807: }
                    808: 
1.561     damieng   809: # Store a parameter value and type by symb, without using the parameter default actions.
                    810: # Expire related sheets.
                    811: #
1.566     damieng   812: # @param {string} $symb - resource symb or map src
1.561     damieng   813: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
                    814: # @param {integer} $snum - level
                    815: # @param {string} $nval - new value
                    816: # @param {string} $ntype - new type
                    817: # @param {string} $uname - username
                    818: # @param {string} $udom - userdomain
                    819: # @param {string} $csec - section name
                    820: # @param {string} $cgroup - group name
                    821: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226     www       822: sub storeparm_by_symb_inner {
1.197     www       823: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   824:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       825: # ---------------------------------------------------------- Construct prefixes
1.186     www       826:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    827:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  828:     $map = &Apache::lonnet::deversion($map);
                    829: 
1.197     www       830:     my $symbparm=$symb.'.'.$spnam;
1.556     raeburn   831:     my $recurseparm=$map.'___(rec).'.$spnam;
1.197     www       832:     my $mapparm=$map.'___(all).'.$spnam;
                    833: 
1.269     raeburn   834:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    835:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   836:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   837:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    838: 
1.190     albertel  839:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    840:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   841:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  842:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    843: 
1.190     albertel  844:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    845:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   846:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  847:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    848: 
1.186     www       849:     my $storeunder='';
1.578     raeburn   850:     my $possreplace='';
1.556     raeburn   851:     if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
1.578     raeburn   852:     if (($snum==17) || ($snum==3)) { 
                    853:         $storeunder=$courseleveli;
                    854:         $possreplace=$courselevelm; 
                    855:     } 
                    856:     if (($snum==16) || ($snum==2)) { 
                    857:         $storeunder=$courselevelm;
                    858:         $possreplace=$courseleveli;
                    859:     }
1.556     raeburn   860:     if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
                    861:     if ($snum==12) { $storeunder=$seclevel; }
1.578     raeburn   862:     if ($snum==11) { 
                    863:         $storeunder=$secleveli;
                    864:         $possreplace=$seclevelm; 
                    865:     }
                    866:     if ($snum==10) { 
                    867:         $storeunder=$seclevelm;
                    868:         $possreplace=$secleveli;
                    869:     }
1.556     raeburn   870:     if ($snum==9) { $storeunder=$seclevelr; }
                    871:     if ($snum==8) { $storeunder=$grplevel; }
1.578     raeburn   872:     if ($snum==7) { 
                    873:         $storeunder=$grpleveli;
                    874:         $possreplace=$grplevelm;
                    875:     }
                    876:     if ($snum==6) {
                    877:         $storeunder=$grplevelm;
                    878:         $possreplace=$grpleveli;
                    879:     }
1.556     raeburn   880:     if ($snum==5) { $storeunder=$grplevelr; }
1.269     raeburn   881: 
1.446     bisitz    882: 
1.186     www       883:     my $delete;
                    884:     if ($nval eq '') { $delete=1;}
                    885:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  886:             $storeunder.'.type' => $ntype);
1.186     www       887:     my $reply='';
1.560     damieng   888:     
1.556     raeburn   889:     if ($snum>4) {
1.186     www       890: # ---------------------------------------------------------------- Store Course
                    891: #
1.560     damieng   892:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    893:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    894:         # Expire sheets
                    895:         &Apache::lonnet::expirespread('','','studentcalc');
                    896:         if (($snum==13) || ($snum==9) || ($snum==5)) {
                    897:             &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.578     raeburn   898:         } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
1.560     damieng   899:             &Apache::lonnet::expirespread('','','assesscalc',$map);
                    900:         } else {
                    901:             &Apache::lonnet::expirespread('','','assesscalc');
                    902:         }
                    903:         # Store parameter
                    904:         if ($delete) {
                    905:             $reply=&Apache::lonnet::del
                    906:             ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
                    907:                 &log_parmset(\%storecontent,1);
                    908:         } else {
                    909:             $reply=&Apache::lonnet::cput
                    910:             ('resourcedata',\%storecontent,$cdom,$cnum);
                    911:             &log_parmset(\%storecontent);
1.578     raeburn   912:             if ($possreplace) {
                    913:                 my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
                    914:                 if (ref($resdata) eq 'HASH') {
                    915:                     if (exists($resdata->{$possreplace})) {
                    916:                         if (&Apache::lonnet::del
                    917:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
                    918:                             &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);   
                    919:                         }
                    920:                     }
                    921:                 }
                    922:             }
1.560     damieng   923:         }
                    924:         &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       925:     } else {
                    926: # ------------------------------------------------------------------ Store User
                    927: #
1.560     damieng   928:         # Expire sheets
                    929:         &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    930:         if ($snum==1) {
                    931:             &Apache::lonnet::expirespread
                    932:             ($uname,$udom,'assesscalc',$symb);
1.578     raeburn   933:         } elsif (($snum==2) || ($snum==3)) {
1.560     damieng   934:             &Apache::lonnet::expirespread
                    935:             ($uname,$udom,'assesscalc',$map);
                    936:         } else {
                    937:             &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    938:         }
                    939:         # Store parameter
                    940:         if ($delete) {
                    941:             $reply=&Apache::lonnet::del
                    942:             ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    943:             &log_parmset(\%storecontent,1,$uname,$udom);
                    944:         } else {
                    945:             $reply=&Apache::lonnet::cput
                    946:             ('resourcedata',\%storecontent,$udom,$uname);
                    947:             &log_parmset(\%storecontent,0,$uname,$udom);
1.578     raeburn   948:             if ($possreplace) {
                    949:                 my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
                    950:                 if (ref($resdata) eq 'HASH') {
                    951:                     if (exists($resdata->{$possreplace})) {
                    952:                         if (&Apache::lonnet::del
                    953:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
                    954:                             &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
                    955:                                           $uname,$udom);
                    956:                         }
                    957:                     }
                    958:                 }
                    959:             }
1.560     damieng   960:         }
                    961:         &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       962:     }
1.446     bisitz    963: 
1.186     www       964:     if ($reply=~/^error\:(.*)/) {
1.560     damieng   965:         return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       966:     }
                    967:     return '';
                    968: }
                    969: 
1.9       www       970: 
1.561     damieng   971: # Returns HTML with the value of the given parameter,
                    972: # using a readable format for dates, and
                    973: # a warning if there is a problem with a date.
                    974: # Used by table mode.
                    975: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
                    976: #
                    977: # @param {string} $value - the parameter value
                    978: # @param {string} $type - the parameter type
                    979: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9       www       980: sub valout {
1.554     raeburn   981:     my ($value,$type,$name,$editable)=@_;
1.59      matthew   982:     my $result = '';
                    983:     # Values of zero are valid.
                    984:     if (! $value && $value ne '0') {
1.528     bisitz    985:         if ($editable) {
                    986:             $result =
                    987:                 '<img src="/res/adm/pages/editmap.png"'
                    988:                .' alt="'.&mt('Change').'"'
1.539     raeburn   989:                .' title="'.&mt('Change').'" style="border:0;" />';
1.528     bisitz    990:         } else {
                    991:             $result='&nbsp;';
                    992:         }
1.59      matthew   993:     } else {
1.66      www       994:         if ($type eq 'date_interval') {
1.559     raeburn   995:             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    996:             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    997:             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    998:                 $donebuttontext = $1;
                    999:                 (undef,$proctor,$secretkey) = split(/_/,$2);
                   1000:                 $usesdone = 'done';
                   1001:             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                   1002:                 $donebuttontext = &mt('Done');
                   1003:                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                   1004:             }
1.554     raeburn  1005:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz   1006:             my @timer;
1.66      www      1007:             $year=$year-70;
                   1008:             $mday--;
                   1009:             if ($year) {
1.413     bisitz   1010: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                   1011:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www      1012:             }
                   1013:             if ($mon) {
1.413     bisitz   1014: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                   1015:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www      1016:             }
                   1017:             if ($mday) {
1.413     bisitz   1018: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                   1019:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www      1020:             }
                   1021:             if ($hour) {
1.413     bisitz   1022: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                   1023:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www      1024:             }
                   1025:             if ($min) {
1.413     bisitz   1026: #               $result.=&mt('[quant,_1,min]',$min).' ';
                   1027:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www      1028:             }
                   1029:             if ($sec) {
1.413     bisitz   1030: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                   1031:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www      1032:             }
1.413     bisitz   1033: #           $result=~s/\s+$//;
                   1034:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                   1035:                 push(@timer,&mt('[quant,_1,sec]',0));
                   1036:             }
                   1037:             $result.=join(", ",@timer);
1.559     raeburn  1038:             if ($usesdone eq 'done') {
1.558     raeburn  1039:                 if ($secretkey) {
1.559     raeburn  1040:                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);  
1.558     raeburn  1041:                 } else {
1.559     raeburn  1042:                     $result .= ' + "'.$donebuttontext.'"';
                   1043:                 }
1.554     raeburn  1044:             }
1.213     www      1045:         } elsif (&isdateparm($type)) {
1.361     albertel 1046:             $result = &Apache::lonlocal::locallocaltime($value).
1.560     damieng  1047:                 &date_sanity_info($value);
1.59      matthew  1048:         } else {
                   1049:             $result = $value;
1.517     www      1050:             $result=~s/\,/\, /gs;
1.560     damieng  1051:             $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew  1052:         }
                   1053:     }
                   1054:     return $result;
1.9       www      1055: }
                   1056: 
1.59      matthew  1057: 
1.561     damieng  1058: # Returns HTML containing a link on a parameter value, for table mode.
                   1059: # The link uses the javascript function 'pjump'.
                   1060: #
                   1061: # @param {string} $type - parameter type
                   1062: # @param {string} $dis - dialog title for editing the parameter value and type
                   1063: # @param {string} $value - parameter value
                   1064: # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
                   1065: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
                   1066: # @param {string} $call - javascript function to call to submit the form ('psub')
1.588     raeburn  1067: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
                   1068: # @param {string} $extra - optional additional information to send as tenth arg in call to javascript pjump function.
1.5       www      1069: sub plink {
1.588     raeburn  1070:     my ($type,$dis,$value,$marker,$return,$call,$recursive,$extra)=@_;
1.23      www      1071:     my $winvalue=$value;
                   1072:     unless ($winvalue) {
1.592     raeburn  1073:         if (&isdateparm($type) || (&is_specialstring($type))) {
1.190     albertel 1074:             $winvalue=$env{'form.recent_'.$type};
1.591     raeburn  1075:         } elsif ($type eq 'string_yesno') {
                   1076:             if ($env{'form.recent_string'} =~ /^(yes|no)$/i) {
                   1077:                 $winvalue=$env{'form.recent_string'};
                   1078:             }
1.23      www      1079:         } else {
1.190     albertel 1080:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1081:         }
                   1082:     }
1.229     www      1083:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1084:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1085:     unless (defined($winvalue)) { $winvalue=$val; }
1.593     raeburn  1086:     my $valout = &valout($value,$type,1);
1.429     raeburn  1087:     my $unencmarker = $marker;
1.378     albertel 1088:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.588     raeburn  1089:               \$hour, \$min, \$sec, \$extra) {
1.560     damieng  1090:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1091:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1092:     }
1.429     raeburn  1093:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1094:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.588     raeburn  1095:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."','".$extra."'".');">'.
1.578     raeburn  1096:         $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
                   1097:                                               &mt('recursive').'</td></tr>' : '').'</table>';
                   1098: 
1.5       www      1099: }
                   1100: 
1.561     damieng  1101: # Javascript for table mode.
1.280     albertel 1102: sub page_js {
                   1103: 
1.81      www      1104:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1105:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1106: 
                   1107:     return(<<ENDJS);
                   1108: <script type="text/javascript">
1.454     bisitz   1109: // <![CDATA[
1.44      albertel 1110: 
1.88      matthew  1111:     $pjump_def
1.44      albertel 1112: 
                   1113:     function psub() {
1.591     raeburn  1114:         var specstring = /^string_!(yesno|any)/i;
1.44      albertel 1115:         if (document.parmform.pres_marker.value!='') {
                   1116:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1117:             var typedef=new Array();
                   1118:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1119:             if (document.parmform.pres_type.value!='') {
1.589     raeburn  1120:                 if ((typedef[0]=='date') || 
1.591     raeburn  1121:                     (specstring.test(document.parmform.pres_type.value)))  {
1.562     damieng  1122:                     eval('document.parmform.recent_'+
                   1123:                         document.parmform.pres_type.value+
                   1124:                         '.value=document.parmform.pres_value.value;');
                   1125:                 } else {
                   1126:                     eval('document.parmform.recent_'+typedef[0]+
                   1127:                         '.value=document.parmform.pres_value.value;');
                   1128:                 }
1.44      albertel 1129:             }
                   1130:             document.parmform.submit();
                   1131:         } else {
                   1132:             document.parmform.pres_value.value='';
                   1133:             document.parmform.pres_marker.value='';
                   1134:         }
                   1135:     }
                   1136: 
1.57      albertel 1137:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1138:         var options = "width=" + w + ",height=" + h + ",";
                   1139:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1140:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1141:         var newWin = window.open(url, wdwName, options);
                   1142:         newWin.focus();
                   1143:     }
1.523     raeburn  1144: 
1.454     bisitz   1145: // ]]>
1.523     raeburn  1146: 
1.44      albertel 1147: </script>
1.81      www      1148: $selscript
1.280     albertel 1149: ENDJS
                   1150: 
                   1151: }
1.507     www      1152: 
1.561     damieng  1153: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1154: # for table and overview modes.
1.523     raeburn  1155: sub showhide_js {
                   1156:     return <<"COURSECONTENTSCRIPT";
                   1157: 
                   1158: function showHide_courseContent() {
                   1159:     var parmlevValue=document.getElementById("parmlev").value;
                   1160:     if (parmlevValue == 'general') {
                   1161:         document.getElementById('mapmenu').style.display="none";
                   1162:     } else {
                   1163:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1164:             document.getElementById('mapmenu').style.display ="";
                   1165:         } else {
                   1166:             document.getElementById('mapmenu').style.display="none";
                   1167:         }
                   1168:     }
                   1169:     return;
                   1170: }
                   1171: 
                   1172: COURSECONTENTSCRIPT
                   1173: }
                   1174: 
1.561     damieng  1175: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1176: sub toggleparmtextbox_js {
                   1177:     return <<"ENDSCRIPT";
                   1178: 
                   1179: if (!document.getElementsByClassName) {
                   1180:     function getElementsByClassName(node, classname) {
                   1181:         var a = [];
                   1182:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1183:         var els = node.getElementsByTagName("*");
                   1184:         for(var i=0,j=els.length; i<j; i++)
                   1185:             if(re.test(els[i].className))a.push(els[i]);
                   1186:         return a;
                   1187:     }
                   1188: }
                   1189: 
                   1190: function showHideLenient() {
                   1191:     var lenients;
                   1192:     var setRegExp = /^set_/;
                   1193:     if (document.getElementsByClassName) {
                   1194:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1195:     } else {
                   1196:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1197:     }
                   1198:     if (lenients != 'undefined') {
                   1199:         for (var i=0; i<lenients.length; i++) {
                   1200:             if (lenients[i].checked) {
                   1201:                 if (lenients[i].value == 'weighted') {
                   1202:                     if (setRegExp.test(lenients[i].name)) {
                   1203:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1204:                         toggleParmTextbox(document.parmform,identifier);
                   1205:                     }
                   1206:                 }
                   1207:             }
                   1208:         }
                   1209:     }
                   1210:     return;
                   1211: }
                   1212: 
                   1213: function toggleParmTextbox(form,key) {
                   1214:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1215:     if (divfortext) {
                   1216:         var caller = form.elements['set_'+key];
                   1217:         if (caller.length) {
                   1218:             for (i=0; i<caller.length; i++) {
                   1219:                 if (caller[i].checked) {
                   1220:                     if (caller[i].value == 'weighted') {
                   1221:                         divfortext.style.display = 'inline';
                   1222:                     } else {
                   1223:                         divfortext.style.display = 'none';
                   1224:                     }
                   1225:                 }
                   1226:             }
                   1227:         }
                   1228:     }
                   1229:     return;
                   1230: }
                   1231: 
                   1232: ENDSCRIPT
                   1233: }
                   1234: 
1.561     damieng  1235: # Javascript function validateParms, for overview mode
1.549     raeburn  1236: sub validateparms_js {
                   1237:     return <<'ENDSCRIPT';
                   1238: 
                   1239: function validateParms() {
                   1240:     var textRegExp = /^settext_/;
                   1241:     var tailLenient = /\.lenient$/;
                   1242:     var patternRelWeight = /^\-?[\d.]+$/;
                   1243:     var patternLenientStd = /^(yes|no|default)$/;
                   1244:     var ipallowRegExp = /^setipallow_/;
                   1245:     var ipdenyRegExp = /^setipdeny_/; 
1.588     raeburn  1246:     var deeplinkRegExp = /^deeplink_(listing|scope)_/;
                   1247:     var deeplinkUrlsRegExp = /^deeplink_urls_/;
                   1248:     var deeplinkltiRegExp = /^deeplink_lti_/;
                   1249:     var deeplinkkeyRegExp = /^deeplink_key_/;
1.549     raeburn  1250:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1251:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1252:         if (document.parmform.elements.length) {
                   1253:             for (i=0; i<document.parmform.elements.length; i++) {
                   1254:                 var name=document.parmform.elements[i].name;
1.588     raeburn  1255:                 if (textRegExp.test(name)) {
1.549     raeburn  1256:                     var identifier = name.replace(textRegExp,'');
                   1257:                     if (tailLenient.test(identifier)) {
                   1258:                         if (document.parmform.elements['set_'+identifier].length) {
                   1259:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1260:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1261:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1262:                                         var relweight = document.parmform.elements[i].value;
                   1263:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1264:                                         if (!patternRelWeight.test(relweight)) {
                   1265:                                             relweight = '0.0';
                   1266:                                         }
                   1267:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1268:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1269:                                         } else {
                   1270:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1271:                                         }
                   1272:                                     }
                   1273:                                     break;
                   1274:                                 }
                   1275:                             }
                   1276:                         }
                   1277:                     }
1.588     raeburn  1278:                 } else if (ipallowRegExp.test(name)) {
                   1279:                     var identifier = name.replace(ipallowRegExp,'');
                   1280:                     var possallow = document.parmform.elements[i].value;
                   1281:                     possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1282:                     if (patternIP.test(possallow)) {
                   1283:                         if (document.parmform.elements['set_'+identifier].value) {
                   1284:                             possallow = ','+possallow;
                   1285:                         }
                   1286:                         document.parmform.elements['set_'+identifier].value += possallow;
                   1287:                     }
                   1288:                 } else if (ipdenyRegExp.test(name)) {
                   1289:                     var identifier = name.replace(ipdenyRegExp,'');
                   1290:                     var possdeny = document.parmform.elements[i].value;
                   1291:                     possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1292:                     if (patternIP.test(possdeny)) {
                   1293:                         possdeny = '!'+possdeny;
                   1294:                         if (document.parmform.elements['set_'+identifier].value) {
                   1295:                             possdeny = ','+possdeny;
                   1296:                         }
                   1297:                         document.parmform.elements['set_'+identifier].value += possdeny;
                   1298:                     }
                   1299:                 } else if (deeplinkRegExp.test(name)) {
                   1300:                     var identifier =  name.replace(deeplinkRegExp,'');
                   1301:                     var possdeeplink = document.parmform.elements[i].value;
                   1302:                     possdeeplink = possdeeplink.replace(/^\s+|\s+$/g,'');
                   1303:                     if (document.parmform.elements['set_'+identifier].value) {
                   1304:                         possdeeplink = ','+possdeeplink;
                   1305:                     }
                   1306:                     document.parmform.elements['set_'+identifier].value += possdeeplink;
                   1307:                 } else if (deeplinkUrlsRegExp.test(name)) {
                   1308:                     if (document.parmform.elements[i].checked) {
                   1309:                         var identifier =  name.replace(deeplinkUrlsRegExp,'');
                   1310:                         var posslinkurl = document.parmform.elements[i].value;
                   1311:                         posslinkurl = posslinkurl.replace(/^\s+|\s+$/g,'');
                   1312:                         if (document.parmform.elements['set_'+identifier].value) {
                   1313:                             posslinkurl = ','+posslinkurl;
                   1314:                         }
                   1315:                         document.parmform.elements['set_'+identifier].value += posslinkurl;
                   1316:                     }
                   1317:                 } else if (deeplinkltiRegExp.test(name)) {
                   1318:                     var identifier = name.replace(deeplinkltiRegExp,'');
                   1319:                     var posslti = document.parmform.elements[i].value;
                   1320:                     posslti = posslti.replace(/\D+/g,'');
                   1321:                     if (document.parmform.elements['set_'+identifier].value) {
                   1322:                         posslti = ':'+posslti;
                   1323:                     }
                   1324:                     document.parmform.elements['set_'+identifier].value += posslti;
                   1325:                 } else if (deeplinkkeyRegExp.test(name)) {
                   1326:                     var identifier = name.replace(deeplinkkeyRegExp,'');
                   1327:                     var posskey = document.parmform.elements[i].value;
                   1328:                     posskey = posskey.replace(/\W+/g,'');
                   1329:                     if (document.parmform.elements['set_'+identifier].value) {
                   1330:                         posslti = ':'+posskey;
1.549     raeburn  1331:                     }
1.588     raeburn  1332:                     document.parmform.elements['set_'+identifier].value += posskey;
1.549     raeburn  1333:                 }
                   1334:             }
                   1335:         }
                   1336:     }
                   1337:     return true;
                   1338: }
                   1339: 
                   1340: ENDSCRIPT
                   1341: }
                   1342: 
1.561     damieng  1343: # Javascript initialization, for overview mode
1.549     raeburn  1344: sub ipacc_boxes_js  {
                   1345:     my $remove = &mt('Remove');
                   1346:     return <<"END";
                   1347: \$(document).ready(function() {
                   1348:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1349:     var add_button      = \$(".LC_add_ipacc_button");
                   1350:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1351: 
                   1352:     \$(add_button).click(function(e){
                   1353:         e.preventDefault();
                   1354:         var identifier = \$(this).closest("div").attr("id");
                   1355:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1356:         \$(this).closest('div').find('.LC_string_ipacc_inner').append('<div><input type="text" name="setip'+identifier+'" /><a href="#" class="LC_remove_ipacc">$remove</a></div>');
1.549     raeburn  1357:     });
                   1358: 
                   1359:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1360:         e.preventDefault(); \$(this).closest("div").remove();
                   1361:     })
                   1362: });
                   1363: 
                   1364: 
                   1365: END
                   1366: }
                   1367: 
1.561     damieng  1368: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1369: sub done_proctor_js {
                   1370:     return <<"END";
                   1371: function toggleSecret(form,radio,key) {
                   1372:     var radios = form[radio+key];
                   1373:     if (radios.length) {
                   1374:         for (var i=0; i<radios.length; i++) {
                   1375:             if (radios[i].checked) {
                   1376:                 if (radios[i].value == '_done_proctor') {
                   1377:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1378:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1379:                     }
                   1380:                 } else {
                   1381:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1382:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1383:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1384:                     }
                   1385:                 }
                   1386:             }
                   1387:         }
                   1388:     }
                   1389: }
                   1390: END
                   1391: 
                   1392: }
                   1393: 
1.588     raeburn  1394: # Javascript function toggle
                   1395: sub deeplink_js {
                   1396:     return <<"END";
                   1397: function toggleDeepLink(form,item,key) {
                   1398:     var radios = form['deeplink_'+item+'_'+key];
                   1399:     if (radios.length) {
                   1400:         var keybox;
                   1401:         if (document.getElementById('deeplink_key_'+item+'_'+key)) {
                   1402:             keybox = document.getElementById('deeplink_key_'+item+'_'+key);
                   1403:         }
                   1404:         var ltidiv;
                   1405:         if (document.getElementById('deeplinkdiv_lti_'+item+'_'+key)) {
                   1406:             ltidiv = document.getElementById('deeplinkdiv_lti_'+item+'_'+key);
                   1407:         }
                   1408:         for (var i=0; i<radios.length; i++) {
                   1409:             if (radios[i].checked) {
                   1410:                 if (radios[i].value == 'lti') {
                   1411:                     ltidiv.style.display = 'inline-block';
                   1412:                     keybox.type = 'hidden';
                   1413:                     keybox.value = '';
                   1414:                 } else {
                   1415:                     if (ltidiv != '') {
                   1416:                         ltidiv.style.display = 'none';
                   1417:                         form['deeplink_lti_'+key].selectedIndex = 0;
                   1418:                     }
                   1419:                     if (radios[i].value == 'key') {
                   1420:                         keybox.type = 'text';
                   1421:                     } else {
                   1422:                         keybox.type = 'hidden';
                   1423:                     }
                   1424:                 }
                   1425:             }
                   1426:         }
                   1427:     }
                   1428: }
                   1429: END
                   1430: 
                   1431: }
                   1432: 
1.561     damieng  1433: # Prints HTML page start for table mode.
                   1434: # @param {Apache2::RequestRec} $r - the Apache request
                   1435: # @param {string} $psymb - resource symb
                   1436: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1437: sub startpage {
1.531     raeburn  1438:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1439: 
1.515     raeburn  1440:     my %loaditems = (
                   1441:                       'onload'   => "group_or_section('cgroup')",
                   1442:                     );
                   1443:     if (!$psymb) {
1.523     raeburn  1444:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1445:     }
1.280     albertel 1446: 
1.560     damieng  1447:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1448:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1449:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1450:             text=>"Problem Parameters"});
1.414     droeschl 1451:     } else {
1.560     damieng  1452:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1453:             text=>"Table Mode",
                   1454:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1455:     }
1.523     raeburn  1456:     my $js = &page_js().'
                   1457: <script type="text/javascript">
                   1458: // <![CDATA[
                   1459: '.
                   1460:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1461: // ]]>
                   1462: </script>
                   1463: ';
1.446     bisitz   1464:     my $start_page =
1.523     raeburn  1465:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1466:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1467:     my $breadcrumbs =
1.473     amueller 1468:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1469:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1470:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1471:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1472:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1473:     $r->print(<<ENDHEAD);
1.193     albertel 1474: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1475: <input type="hidden" value="" name="pres_value" />
                   1476: <input type="hidden" value="" name="pres_type" />
                   1477: <input type="hidden" value="" name="pres_marker" />
                   1478: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1479: <input type="hidden" value="$escfilter" name="filter" />
                   1480: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1481: ENDHEAD
                   1482: }
                   1483: 
1.209     www      1484: 
1.561     damieng  1485: # Prints a row for table mode (except for the tr start).
                   1486: # Every time a hash reference is passed, a single entry is used, so print_row
                   1487: # could just use these values, but why make it simple when it can be complicated ?
                   1488: #
                   1489: # @param {Apache2::RequestRec} $r - the Apache request
                   1490: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1491: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1492: # @param {hash reference} $name - parameter key -> parameter name
1.566     damieng  1493: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561     damieng  1494: # @param {string} $rid - resource id
                   1495: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1496: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1497: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1498: # @param {string} $defbgone - user level and other levels background color
                   1499: # @param {string} $defbgtwo - section level background color, also used for part number
                   1500: # @param {string} $defbgthree - group level background color
                   1501: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1502: # @param {string} $uname - user name
                   1503: # @param {string} $udom - user domain
                   1504: # @param {string} $csec - section name
                   1505: # @param {string} $cgroup - group name
                   1506: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1507: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.582     raeburn  1508: # @param {boolean} $readonly - true if no editing allowed.
                   1509: # @param {array reference} - $recurseup - list of maps containing current one, ending at top-level.
                   1510: # @param {hash reference} - $maptitles - - hash map id or src -> map title 
                   1511: # @param {hash reference} - $allmaps_inverted - hash map src -> map pc
                   1512: # @param {scalar reference} - $reclinks - number of "parameter in effect" cells with link to map where recursive param was set 
1.44      albertel 1513: sub print_row {
1.201     www      1514:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568     raeburn  1515:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
1.582     raeburn  1516:     $readonly,$recurseup,$maptitles,$allmaps_inverted,$reclinks)=@_;
1.275     raeburn  1517:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1518:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1519:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.582     raeburn  1520:     my $numlinks = 0;
1.553     raeburn  1521: 
1.560     damieng  1522:     # get the values for the parameter in cascading order
                   1523:     # empty levels will remain empty
1.44      albertel 1524:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1525:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1526:     # get the type for the parameters
                   1527:     # problem: these may not be set for all levels
1.66      www      1528:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1529:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1530:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1531:     # cascade down manually
1.182     albertel 1532:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1533:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1534:         if ($typeoutpar[$i]) {
1.66      www      1535:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1536:         } else {
1.66      www      1537:             $typeoutpar[$i]=$cascadetype;
                   1538:         }
                   1539:     }
1.57      albertel 1540:     my $parm=$$display{$which};
                   1541: 
1.203     www      1542:     if ($parmlev eq 'full') {
1.419     bisitz   1543:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1544:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1545:     } else {
1.57      albertel 1546:         $parm=~s|\[.*\]\s||g;
                   1547:     }
1.231     www      1548:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1549:     if ($automatic) {
1.560     damieng  1550:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1551:     }
1.427     bisitz   1552:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1553: 
1.44      albertel 1554:     my $thismarker=$which;
                   1555:     $thismarker=~s/^parameter\_//;
                   1556:     my $mprefix=$rid.'&'.$thismarker.'&';
1.582     raeburn  1557:     my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1558:     my ($othergrp,$grp_parm,$controlgrp,$effective_parm,$effparm_rec,$effparm_level,
1.588     raeburn  1559:         $eff_groupparm,$recurse_check,$recursinfo,$extra);
1.582     raeburn  1560:     if ((ref($recurseup) eq 'ARRAY') && (@{$recurseup} > 0)) {
                   1561:         if ($result eq '') {
                   1562:             $recurse_check = 1;
                   1563:         } elsif (($uname ne '') && ($result > 3)) {
                   1564:             $recurse_check = 1;
                   1565:         } elsif (($cgroup ne '') && ($result > 7)) {
                   1566:             $recurse_check = 1;
                   1567:         } elsif (($csec ne '') && ($result > 11)) {
                   1568:             $recurse_check = 1;
                   1569:         } elsif ($result > 17) {
                   1570:             $recurse_check = 1;
                   1571:         }
                   1572:         if ($recurse_check) {
                   1573:             my $what = $$part{$which}.'.'.$$name{$which};
                   1574:             my $prefix;
                   1575:             if (($uname ne '') && ($udom ne '')) {
                   1576:                 my $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
                   1577:                 $prefix = $env{'request.course.id'};
                   1578:                 $recursinfo = &get_recursive($recurseup,$useropt,$what,$prefix);
                   1579:                 if (ref($recursinfo) eq 'ARRAY') {
                   1580:                     $effparm_rec = 1;
                   1581:                     $effparm_level = &mt('user: [_1]',$uname);
                   1582:                 }
                   1583:             }
                   1584:             if (($cgroup ne '') && (!$effparm_rec)) {
                   1585:                 $prefix = $env{'request.course.id'}.'.['.$cgroup.']';
                   1586:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1587:                 if (ref($recursinfo) eq 'ARRAY') {
                   1588:                     $effparm_rec = 1;
                   1589:                     $effparm_level = &mt('group: [_1]',$cgroup);
                   1590:                 }
                   1591:             }
                   1592:             if (($csec ne '') && (!$effparm_rec)) {
                   1593:                 $prefix = $env{'request.course.id'}.'.['.$csec.']';
                   1594:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1595:                 if (ref($recursinfo) eq 'ARRAY') {
                   1596:                     $effparm_rec = 1;
                   1597:                     $effparm_level = &mt('section: [_1]',$csec);
                   1598:                 }
                   1599:             }
                   1600:             if (!$effparm_rec) {
                   1601:                 $prefix = $env{'request.course.id'};
                   1602:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix); 
                   1603:                 if (ref($recursinfo) eq 'ARRAY') {
                   1604:                     $effparm_rec = 1;
                   1605:                 }
                   1606:             }
                   1607:         }
                   1608:     }
                   1609:     if ((!$effparm_rec) && ($result == 17 || $result == 11 || $result == 7 || $result == 3)) {
                   1610:         $effparm_rec = 1;
                   1611:     }
                   1612:     if ((!$effparm_rec) && 
                   1613:         (($$name{$which} eq 'encrypturl') || ($$name{$which} eq 'hiddenresource')) && 
                   1614:         ($result == 16 || $result == 10 || $result == 6 || $result == 2)) {
1.578     raeburn  1615:         $effparm_rec = 1;
                   1616:     }
1.588     raeburn  1617:     if ($parmname eq 'deeplink') {
                   1618:         my %posslti;
                   1619:         my %lti =
                   1620:             &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   1621:                                             'provider');
                   1622:         foreach my $item (keys(%lti)) {
                   1623:             if (ref($lti{$item}) eq 'HASH') {
                   1624:                 unless ($lti{$item}{'requser'}) {
                   1625:                     $posslti{$item} = $lti{$item}{'consumer'};
                   1626:                 }
                   1627:             }
                   1628:         }
                   1629:         if (keys(%posslti)) {
                   1630:             $extra = 'lti_';
                   1631:             foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   1632:                 $extra .= $lti.':'.&js_escape($posslti{$lti}).',';
                   1633:             }
                   1634:             $extra =~ s/,$//;
                   1635:         }
                   1636:     }
1.57      albertel 1637:     if ($parmlev eq 'general') {
                   1638:         if ($uname) {
1.588     raeburn  1639:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.269     raeburn  1640:         } elsif ($cgroup) {
1.588     raeburn  1641:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
1.57      albertel 1642:         } elsif ($csec) {
1.588     raeburn  1643:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1644:         } else {
1.588     raeburn  1645:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1646:         }
                   1647:     } elsif ($parmlev eq 'map') {
                   1648:         if ($uname) {
1.588     raeburn  1649:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.269     raeburn  1650:         } elsif ($cgroup) {
1.588     raeburn  1651:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
1.57      albertel 1652:         } elsif ($csec) {
1.588     raeburn  1653:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1654:         } else {
1.588     raeburn  1655:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1656:         }
                   1657:     } else {
1.275     raeburn  1658:         if ($uname) {
                   1659:             if (@{$usersgroups} > 1) {
1.582     raeburn  1660:                 (my $coursereply,$othergrp,$grp_parm,$controlgrp,my $grp_is_rec) =
1.580     raeburn  1661:                     &check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1662:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.582     raeburn  1663:                 if (($coursereply) && ($result > 4)) {
1.275     raeburn  1664:                     if (defined($controlgrp)) {
                   1665:                         if ($cgroup ne $controlgrp) {
1.582     raeburn  1666:                             $eff_groupparm = $grp_parm;
                   1667:                             undef($result);
                   1668:                             undef($effparm_rec);
                   1669:                             if ($grp_is_rec) {
                   1670:                                  $effparm_rec = 1;
                   1671:                             }
1.275     raeburn  1672:                         }
                   1673:                     }
                   1674:                 }
                   1675:             }
                   1676:         }
1.57      albertel 1677: 
1.588     raeburn  1678:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1679:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1680:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1681:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1682:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1683: 
                   1684:         if ($csec) {
1.588     raeburn  1685:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1686:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1687:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1688:         }
1.269     raeburn  1689: 
                   1690:         if ($cgroup) {
1.588     raeburn  1691:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
                   1692:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
                   1693:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly,'',$extra);
1.269     raeburn  1694:         }
1.446     bisitz   1695: 
1.548     raeburn  1696:         if ($uname) {
1.275     raeburn  1697:             if ($othergrp) {
                   1698:                 $r->print($othergrp);
                   1699:             }
1.588     raeburn  1700:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1701:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1702:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1703:         }
1.57      albertel 1704:     } # end of $parmlev if/else
1.582     raeburn  1705:     if (ref($recursinfo) eq 'ARRAY') {
                   1706:         my $rectitle = &mt('recursive');
                   1707:         if ((ref($maptitles) eq 'HASH') && (exists($maptitles->{$recursinfo->[2]}))) {
                   1708:             if ((ref($allmaps_inverted) eq 'HASH') && (exists($allmaps_inverted->{$recursinfo->[2]}))) {
                   1709:                 $rectitle = &mt('set in: [_1]','"'.
                   1710:                                 '<a href="javascript:pjumprec('."'".$allmaps_inverted->{$recursinfo->[2]}."',".
                   1711:                                                               "'$parmname','$$part{$which}'".');">'.
                   1712:                                 $maptitles->{$recursinfo->[2]}.'</a>"');
                   1713:               
                   1714:                 $numlinks ++;
                   1715:             }
                   1716:         }
                   1717:         my ($parmname)=($thismarker=~/\_([^\_]+)$/);
1.593     raeburn  1718:         $effective_parm = &valout($recursinfo->[0],$recursinfo->[1]);
1.582     raeburn  1719:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1720:                   '<br /><span class="LC_parm_recursive">'.$rectitle.'&nbsp;'.
                   1721:                   $effparm_level.'</span></td>');
                   1722:     } else {
                   1723:         if ($result) {
1.593     raeburn  1724:             $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
1.582     raeburn  1725:         }
                   1726:         if ($eff_groupparm) {
                   1727:             $effective_parm = $eff_groupparm;
                   1728:         }
                   1729:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1730:                   ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
                   1731:                                 '</span>':'').'</td>');
                   1732:     }
1.203     www      1733:     if ($parmlev eq 'full') {
1.136     albertel 1734:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1735:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1736:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1737:         if (!defined($sessionvaltype)) {
                   1738:             $sessionvaltype=$$defaulttype{$which};
                   1739:         }
1.419     bisitz   1740:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.593     raeburn  1741:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel 1742:                   '</font></td>');
1.136     albertel 1743:     }
1.44      albertel 1744:     $r->print('</tr>');
1.57      albertel 1745:     $r->print("\n");
1.582     raeburn  1746:     if (($numlinks) && (ref($reclinks))) {
                   1747:         $$reclinks = $numlinks;
                   1748:     }
1.44      albertel 1749: }
1.59      matthew  1750: 
1.561     damieng  1751: # Prints a cell for table mode.
                   1752: #
                   1753: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1754: # Also, it would make more sense to pass the display for this cell rather
                   1755: # than the full display hash and the key to use.
                   1756: #
                   1757: # @param {Apache2::RequestRec} $r - the Apache request
                   1758: # @param {integer} $which - level
                   1759: # @param {string} $defbg - cell background color
                   1760: # @param {integer} $result - the most specific level that is defined for that parameter
                   1761: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1762: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1763: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1764: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1765: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1766: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1767: # @param {boolean} $readonly -true if editing not allowed.
1.588     raeburn  1768: # @param {boolean} $ismaplevel - true if level is for a map.
                   1769: # @param {strring} $extra - extra informatio to pass to plink.
1.44      albertel 1770: sub print_td {
1.578     raeburn  1771:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
1.588     raeburn  1772:         $noeditgrp,$readonly,$ismaplevel,$extra)=@_;
1.578     raeburn  1773:     my ($ineffect,$recursive,$currval,$currtype,$currlevel);
                   1774:     $ineffect = 0;
                   1775:     $currval = $$outpar[$which];
                   1776:     $currtype = $$typeoutpar[$which];
                   1777:     $currlevel = $which;
                   1778:     if (($result) && ($result == $which)) {
                   1779:         $ineffect = 1;
                   1780:     } 
                   1781:     if ($ismaplevel) {
                   1782:         if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
                   1783:             if (($result) && ($result == $which)) {
                   1784:                 $recursive = 1;
                   1785:             }
                   1786:         } elsif ($$outpar[$which+1] ne '') {
                   1787:             $recursive = 1;
                   1788:             $currlevel = $which+1;
                   1789:             $currval = $$outpar[$currlevel];
                   1790:             $currtype = $$typeoutpar[$currlevel];
                   1791:             if (($result) && ($result == $currlevel)) {
                   1792:                 $ineffect = 1;
                   1793:             }
                   1794:         }
                   1795:     }
                   1796:     $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419     bisitz   1797:               ';" align="center">');
1.437     raeburn  1798:     my $nolink = 0;
1.568     raeburn  1799:     if ($readonly) {
1.552     raeburn  1800:         $nolink = 1;
1.568     raeburn  1801:     } else { 
1.578     raeburn  1802:         if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553     raeburn  1803:             $nolink = 1;
1.568     raeburn  1804:         } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533     raeburn  1805:             $nolink = 1;
1.568     raeburn  1806:         } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
                   1807:             if ($noeditgrp) {
                   1808:                 $nolink = 1;
                   1809:             }
                   1810:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1811:             if ($which > 4) {
                   1812:                 $nolink = 1;
                   1813:             }
                   1814:         } elsif ($mprefix =~ /examcode\&$/) {
                   1815:             unless ($which == 2) {
                   1816:                 $nolink = 1;
                   1817:             }
1.533     raeburn  1818:         }
1.437     raeburn  1819:     }
                   1820:     if ($nolink) {
1.577     raeburn  1821:         my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.593     raeburn  1822:         $r->print(&valout($currval,$currtype));
1.114     www      1823:     } else {
1.578     raeburn  1824:         $r->print(&plink($currtype,
                   1825:                          $$display{$value},$currval,
1.588     raeburn  1826:                          $mprefix.$currlevel,'parmform.pres','psub',$recursive,
                   1827:                          $extra));
1.114     www      1828:     }
                   1829:     $r->print('</td>'."\n");
1.57      albertel 1830: }
                   1831: 
1.561     damieng  1832: # Returns HTML and other info for the cell added when a user is selected
                   1833: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1834: #
                   1835: # @param {string} $what - parameter part.'.'.parameter name
                   1836: # @param {string} $rid - resource id
                   1837: # @param {string} $cgroup - group name
                   1838: # @param {string} $defbg - cell background color
                   1839: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1840: # @param {integer} $result - level
                   1841: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
1.582     raeburn  1842: # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group, true if recursive)
1.580     raeburn  1843: sub check_other_groups {
                   1844:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1845:     my $courseid = $env{'request.course.id'};
                   1846:     my $output;
                   1847:     my $symb = &symbcache($rid);
                   1848:     my $symbparm=$symb.'.'.$what;
                   1849:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1850:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1851:     my $mapparm=$map.'___(all).'.$what;
                   1852:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1853:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1854:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1855:     my $bgcolor = $defbg;
1.582     raeburn  1856:     my ($grp_parm,$grp_is_rec);
1.446     bisitz   1857:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.582     raeburn  1858:         my ($parmname) = ($what =~ /\.([^.]+)$/);
1.275     raeburn  1859:         if ($result > 3) {
1.419     bisitz   1860:             $bgcolor = '#AAFFAA';
1.275     raeburn  1861:         }
1.593     raeburn  1862:         $grp_parm = &valout($coursereply,$resulttype);
1.419     bisitz   1863:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1864:         if ($resultgroup && $resultlevel) {
1.582     raeburn  1865:             if ($resultlevel eq 'recursive') {
                   1866:                 $resultlevel = 'map/folder';
                   1867:                 $grp_is_rec = 1;
                   1868:             }
                   1869:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm.
                   1870:                        ($grp_is_rec?'<span class="LC_parm_recursive">'.&mt('recursive').'</span>':'');
                   1871:              
1.275     raeburn  1872:         } else {
                   1873:             $output .= '&nbsp;';
                   1874:         }
                   1875:         $output .= '</td>';
                   1876:     } else {
1.419     bisitz   1877:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1878:     }
1.582     raeburn  1879:     return ($coursereply,$output,$grp_parm,$resultgroup,$grp_is_rec);
1.275     raeburn  1880: }
                   1881: 
1.561     damieng  1882: # Looks for a group with a defined parameter for given user and parameter.
1.580     raeburn  1883: # Used by check_other_groups.
1.561     damieng  1884: #
                   1885: # @param {string} $courseid - the course id
                   1886: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1887: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1888: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1889: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1890: # @param {string} $what - parameter part.'.'.parameter name
                   1891: # @param {hash reference} $courseopt - course parameters hash
                   1892: # @returns {Array} - (parameter value for the group, course parameter hash key for the parameter, name of the group, level name, parameter type)
1.275     raeburn  1893: sub parm_control_group {
1.556     raeburn  1894:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1895:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1896:     my $grpfound = 0;
1.556     raeburn  1897:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1898:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1899:     foreach my $group (@{$usersgroups}) {
                   1900:         if ($grpfound) { last; }
                   1901:         for (my $i=0; $i<@levels; $i++) {
                   1902:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1903:             if (defined($$courseopt{$item})) {
                   1904:                 $coursereply = $$courseopt{$item};
                   1905:                 $resultitem = $item;
                   1906:                 $resultgroup = $group;
                   1907:                 $resultlevel = $levelnames[$i];
                   1908:                 $resulttype = $$courseopt{$item.'.type'};
                   1909:                 $grpfound = 1;
                   1910:                 last;
                   1911:             }
                   1912:         }
                   1913:     }
                   1914:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1915: }
1.201     www      1916: 
1.63      bowersj2 1917: 
                   1918: 
1.562     damieng  1919: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1920: # All the parameters are references and are filled by the sub.
                   1921: #
1.566     damieng  1922: # @param {array reference} $ids - resource and map ids
                   1923: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
                   1924: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562     damieng  1925: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1926: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566     damieng  1927: # @param {hash reference} $allmaps - hash map pc -> map src
                   1928: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
                   1929: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
                   1930: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
                   1931: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562     damieng  1932: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1933: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1934: sub extractResourceInformation {
                   1935:     my $ids = shift;
                   1936:     my $typep = shift;
                   1937:     my $keyp = shift;
                   1938:     my $allparms = shift;
                   1939:     my $allparts = shift;
                   1940:     my $allmaps = shift;
                   1941:     my $mapp = shift;
                   1942:     my $symbp = shift;
1.82      www      1943:     my $maptitles=shift;
1.196     www      1944:     my $uris=shift;
1.210     www      1945:     my $keyorder=shift;
1.211     www      1946:     my $defkeytype=shift;
1.196     www      1947: 
1.210     www      1948:     my $keyordercnt=100;
1.63      bowersj2 1949: 
1.196     www      1950:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1951:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1952:     foreach my $resource (@allres) {
1.480     amueller 1953:         my $id=$resource->id();
1.196     www      1954:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1955:         if ($mapid eq '0') { next; }
                   1956:         $$ids[$#$ids+1]=$id;
                   1957:         my $srcf=$resource->src();
                   1958:         $srcf=~/\.(\w+)$/;
                   1959:         $$typep{$id}=$1;
1.584     raeburn  1960:         my $toolsymb;
                   1961:         if ($srcf =~ /ext\.tool$/) {
                   1962:             $toolsymb = $resource->symb();
                   1963:         }
1.480     amueller 1964:         $$keyp{$id}='';
1.196     www      1965:         $$uris{$id}=$srcf;
1.512     foxr     1966: 
1.584     raeburn  1967:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys',$toolsymb))) {
1.480     amueller 1968:             next if ($key!~/^parameter_/);
1.363     albertel 1969: 
1.209     www      1970: # Hidden parameters
1.584     raeburn  1971:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden',$toolsymb) eq 'parm');
1.209     www      1972: #
                   1973: # allparms is a hash of parameter names
                   1974: #
1.584     raeburn  1975:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name',$toolsymb);
1.480     amueller 1976:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1977:                 my ($display,$parmdis);
                   1978:                 $display = &standard_parameter_names($name);
                   1979:                 if ($display eq '') {
1.584     raeburn  1980:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display',$toolsymb);
1.480     amueller 1981:                     $parmdis = $display;
                   1982:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1983:                 } else {
                   1984:                     $parmdis = &mt($display);
                   1985:                 }
                   1986:                 $$allparms{$name}=$parmdis;
                   1987:                 if (ref($defkeytype)) {
                   1988:                     $$defkeytype{$name}=
1.584     raeburn  1989:                     &Apache::lonnet::metadata($srcf,$key.'.type',$toolsymb);
1.480     amueller 1990:                 }
                   1991:             }
1.363     albertel 1992: 
1.209     www      1993: #
                   1994: # allparts is a hash of all parts
                   1995: #
1.584     raeburn  1996:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part',$toolsymb);
1.480     amueller 1997:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1998: #
                   1999: # Remember all keys going with this resource
                   2000: #
1.480     amueller 2001:             if ($$keyp{$id}) {
                   2002:                 $$keyp{$id}.=','.$key;
                   2003:             } else {
                   2004:                 $$keyp{$id}=$key;
                   2005:             }   
1.210     www      2006: #
                   2007: # Put in order
1.446     bisitz   2008: #
1.480     amueller 2009:             unless ($$keyorder{$key}) {
                   2010:                 $$keyorder{$key}=$keyordercnt;
                   2011:                 $keyordercnt++;
                   2012:             }
1.473     amueller 2013:         }
                   2014: 
                   2015: 
1.480     amueller 2016:         if (!exists($$mapp{$mapid})) {
                   2017:             $$mapp{$id}=
                   2018:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   2019:             $$mapp{$mapid}=$$mapp{$id};
                   2020:             $$allmaps{$mapid}=$$mapp{$id};
                   2021:             if ($mapid eq '1') {
1.532     raeburn  2022:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 2023:             } else {
                   2024:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   2025:             }
                   2026:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  2027:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   2028:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   2029:                                                      # are commented out in rev. 1.57
1.473     amueller 2030:         } else {
1.480     amueller 2031:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 2032:         }
1.480     amueller 2033:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 2034:     }
                   2035: }
                   2036: 
1.582     raeburn  2037: sub get_recursive {
                   2038:     my ($recurseup,$resdata,$what,$prefix) = @_; 
                   2039:     if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
                   2040:         foreach my $item (@{$recurseup}) {
                   2041:             my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
                   2042:             if (defined($resdata->{$norecursechk})) {
                   2043:                 if ($what =~ /\.(encrypturl|hiddenresource)$/) {
                   2044:                     my $type = $resdata->{$norecursechk.'.type'};
                   2045:                     return [$resdata->{$norecursechk},$type,$item];
                   2046:                 } else {
                   2047:                     last;
                   2048:                 }
                   2049:             }
                   2050:             my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
                   2051:             if (defined($resdata->{$recursechk})) {
                   2052:                 my $type = $resdata->{$recursechk.'.type'};
                   2053:                 return [$resdata->{$recursechk},$type,$item];
                   2054:             }
                   2055:         }
                   2056:     }
                   2057:     return;
                   2058: }
                   2059: 
1.208     www      2060: 
1.562     damieng  2061: # Tells if a parameter type is a date.
                   2062: #
                   2063: # @param {string} type - parameter type
                   2064: # @returns{boolean} - true if it is a date
1.213     www      2065: sub isdateparm {
                   2066:     my $type=shift;
                   2067:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   2068: }
                   2069: 
1.589     raeburn  2070: # Determine if parameter type is specialized string type (i.e.,
                   2071: # not just string or string_yesno.  
                   2072: 
                   2073: sub is_specialstring {
                   2074:     my $type=shift;
1.590     raeburn  2075:     return (($type=~/^string_/) && (($type ne 'string_yesno')));
1.589     raeburn  2076: }
                   2077: 
1.562     damieng  2078: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 2079: #
1.581     raeburn  2080: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      2081: sub parmmenu {
1.581     raeburn  2082:     my ($r)=@_;
1.208     www      2083:     $r->print(<<ENDSCRIPT);
                   2084: <script type="text/javascript">
1.454     bisitz   2085: // <![CDATA[
1.208     www      2086:     function checkall(value, checkName) {
1.453     schualex 2087: 
                   2088:         var li = "_li";
                   2089:         var displayOverview = "";
                   2090:         
                   2091:         if (value == false) {
                   2092:             displayOverview = "none"
                   2093:         }
                   2094: 
1.562     damieng  2095:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      2096:             ele = document.forms.parmform.elements[i];
                   2097:             if (ele.name == checkName) {
                   2098:                 document.forms.parmform.elements[i].checked=value;
                   2099:             }
                   2100:         }
                   2101:     }
1.210     www      2102: 
                   2103:     function checkthis(thisvalue, checkName) {
1.562     damieng  2104:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      2105:             ele = document.forms.parmform.elements[i];
                   2106:             if (ele.name == checkName) {
1.562     damieng  2107:                 if (ele.value == thisvalue) {
                   2108:                     document.forms.parmform.elements[i].checked=true;
                   2109:                 }
1.210     www      2110:             }
                   2111:         }
                   2112:     }
                   2113: 
                   2114:     function checkdates() {
1.562     damieng  2115:         checkthis('duedate','pscat');
                   2116:         checkthis('opendate','pscat');
                   2117:         checkthis('answerdate','pscat');
1.218     www      2118:     }
                   2119: 
                   2120:     function checkdisset() {
1.562     damieng  2121:         checkthis('discussend','pscat');
                   2122:         checkthis('discusshide','pscat');
                   2123:         checkthis('discussvote','pscat');
1.218     www      2124:     }
                   2125: 
                   2126:     function checkcontdates() {
1.562     damieng  2127:         checkthis('contentopen','pscat');
                   2128:         checkthis('contentclose','pscat');
1.218     www      2129:     }
1.446     bisitz   2130: 
1.210     www      2131:     function checkvisi() {
1.562     damieng  2132:         checkthis('hiddenresource','pscat');
                   2133:         checkthis('encrypturl','pscat');
                   2134:         checkthis('problemstatus','pscat');
                   2135:         checkthis('contentopen','pscat');
                   2136:         checkthis('opendate','pscat');
1.210     www      2137:     }
                   2138: 
                   2139:     function checkparts() {
1.562     damieng  2140:         checkthis('hiddenparts','pscat');
                   2141:         checkthis('display','pscat');
                   2142:         checkthis('ordered','pscat');
1.210     www      2143:     }
                   2144: 
                   2145:     function checkstandard() {
                   2146:         checkall(false,'pscat');
1.562     damieng  2147:         checkdates();
                   2148:         checkthis('weight','pscat');
                   2149:         checkthis('maxtries','pscat');
                   2150:         checkthis('type','pscat');
                   2151:         checkthis('problemstatus','pscat');
1.210     www      2152:     }
                   2153: 
1.454     bisitz   2154: // ]]>
1.208     www      2155: </script>
                   2156: ENDSCRIPT
1.453     schualex 2157: 
1.491     bisitz   2158:     $r->print('<hr />');
1.581     raeburn  2159:     &shortCuts($r);
1.491     bisitz   2160:     $r->print('<hr />');
1.453     schualex 2161: }
1.562     damieng  2162: 
                   2163: # Returns parameter categories.
                   2164: #
                   2165: # @returns {hash} - category name -> title in English
1.465     amueller 2166: sub categories {
                   2167:     return ('time_settings' => 'Time Settings',
                   2168:     'grading' => 'Grading',
                   2169:     'tries' => 'Tries',
                   2170:     'problem_appearance' => 'Problem Appearance',
                   2171:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   2172:     'hiding' => 'Hiding',
                   2173:     'high_level_randomization' => 'High Level Randomization',
                   2174:     'slots' => 'Slots',
                   2175:     'file_submission' => 'File Submission',
                   2176:     'misc' => 'Miscellaneous' ); 
                   2177: }
                   2178: 
1.562     damieng  2179: # Returns the category for each parameter.
                   2180: #
                   2181: # @returns {hash} - parameter name -> category name
1.465     amueller 2182: sub lookUpTableParameter {
                   2183:  
                   2184:     return ( 
                   2185:         'opendate' => 'time_settings',
                   2186:         'duedate' => 'time_settings',
                   2187:         'answerdate' => 'time_settings',
                   2188:         'interval' => 'time_settings',
                   2189:         'contentopen' => 'time_settings',
                   2190:         'contentclose' => 'time_settings',
                   2191:         'discussend' => 'time_settings',
1.560     damieng  2192:         'printstartdate' => 'time_settings',
                   2193:         'printenddate' => 'time_settings',
1.465     amueller 2194:         'weight' => 'grading',
                   2195:         'handgrade' => 'grading',
                   2196:         'maxtries' => 'tries',
                   2197:         'hinttries' => 'tries',
1.503     raeburn  2198:         'randomizeontries' => 'tries',
1.465     amueller 2199:         'type' => 'problem_appearance',
                   2200:         'problemstatus' => 'problem_appearance',
                   2201:         'display' => 'problem_appearance',
                   2202:         'ordered' => 'problem_appearance',
                   2203:         'numbubbles' => 'problem_appearance',
                   2204:         'tol' => 'behaviour_of_input_fields',
                   2205:         'sig' => 'behaviour_of_input_fields',
                   2206:         'turnoffunit' => 'behaviour_of_input_fields',
                   2207:         'hiddenresource' => 'hiding',
                   2208:         'hiddenparts' => 'hiding',
                   2209:         'discusshide' => 'hiding',
                   2210:         'buttonshide' => 'hiding',
                   2211:         'turnoffeditor' => 'hiding',
                   2212:         'encrypturl' => 'hiding',
1.587     raeburn  2213:         'deeplink' => 'hiding',
1.465     amueller 2214:         'randomorder' => 'high_level_randomization',
                   2215:         'randompick' => 'high_level_randomization',
                   2216:         'available' => 'slots',
                   2217:         'useslots' => 'slots',
                   2218:         'availablestudent' => 'slots',
                   2219:         'uploadedfiletypes' => 'file_submission',
                   2220:         'maxfilesize' => 'file_submission',
                   2221:         'cssfile' => 'misc',
                   2222:         'mapalias' => 'misc',
                   2223:         'acc' => 'misc',
                   2224:         'maxcollaborators' => 'misc',
                   2225:         'scoreformat' => 'misc',
1.514     raeburn  2226:         'lenient' => 'grading',
1.519     raeburn  2227:         'retrypartial' => 'tries',
1.521     raeburn  2228:         'discussvote'  => 'misc',
1.584     raeburn  2229:         'examcode' => 'high_level_randomization',
1.575     raeburn  2230:     );
1.465     amueller 2231: }
                   2232: 
1.562     damieng  2233: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2234: #
                   2235: # @param {string} $name - parameter name
                   2236: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2237: sub whatIsMyCategory {
                   2238:     my $name = shift;
                   2239:     my $catList = shift;
                   2240:     my @list;
                   2241:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2242:     my $cat = $lookUpList{$name};
                   2243:     if (defined($cat)) {
                   2244:         if (!defined($$catList{$cat})){
                   2245:             push @list, ($name);
                   2246:             $$catList{$cat} = \@list;
                   2247:         } else {
                   2248:             push @{${$catList}{$cat}}, ($name);     
                   2249:         }
                   2250:     } else {
                   2251:         if (!defined($$catList{'misc'})){
                   2252:             push @list, ($name);
                   2253:             $$catList{'misc'} = \@list;
                   2254:         } else {
                   2255:             push @{${$catList}{'misc'}}, ($name);     
                   2256:         }
                   2257:     }        
                   2258: }
                   2259: 
1.562     damieng  2260: # Sorts parameter names based on appearance order.
                   2261: #
                   2262: # @param {array reference} name - array reference of parameter names
                   2263: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2264: # @returns {Array} - array of parameter names
1.465     amueller 2265: sub keysindisplayorderCategory {
                   2266:     my ($name,$keyorder)=@_;
                   2267:     return sort {
1.473     amueller 2268:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2269:     } ( @{$name});
                   2270: }
                   2271: 
1.562     damieng  2272: # Returns a hash category name -> order, starting at 1 (integer)
                   2273: #
                   2274: # @returns {hash}
1.467     amueller 2275: sub category_order {
                   2276:     return (
                   2277:         'time_settings' => 1,
                   2278:         'grading' => 2,
                   2279:         'tries' => 3,
                   2280:         'problem_appearance' => 4,
                   2281:         'hiding' => 5,
                   2282:         'behaviour_of_input_fields' => 6,
                   2283:         'high_level_randomization'  => 7,
                   2284:         'slots' => 8,
                   2285:         'file_submission' => 9,
                   2286:         'misc' => 10
                   2287:     );
                   2288: 
                   2289: }
1.453     schualex 2290: 
1.562     damieng  2291: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2292: #
                   2293: # @param {Apache2::RequestRec} $r - the Apache request
                   2294: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2295: # @param {array reference} $pscat - list of selected parameter names
                   2296: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2297: sub parmboxes {
                   2298:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2299:     my %categories = &categories();
1.467     amueller 2300:     my %category_order = &category_order();
1.465     amueller 2301:     my %categoryList = (
                   2302:         'time_settings' => [],
                   2303:         'grading' => [],
                   2304:         'tries' => [],
                   2305:         'problem_appearance' => [],
                   2306:         'behaviour_of_input_fields' => [],
                   2307:         'hiding' => [],
                   2308:         'high_level_randomization' => [],
                   2309:         'slots' => [],
                   2310:         'file_submission' => [],
                   2311:         'misc' => [],
1.489     bisitz   2312:     );
1.510     www      2313: 
1.548     raeburn  2314:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2315:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2316:     }
1.453     schualex 2317:     #part to print the parm-list
1.536     raeburn  2318:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2319:         next if (@{$categoryList{$key}} == 0);
                   2320:         next if ($key eq '');
                   2321:         $r->print('<div class="LC_Box LC_400Box">'
                   2322:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2323:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2324:             next if ($tempkey eq '');
1.536     raeburn  2325:             $r->print('<span class="LC_nobreak">'
                   2326:                      .'<label><input type="checkbox" name="pscat" '
                   2327:                      .'value="'.$tempkey.'" ');
                   2328:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2329:                 $r->print( ' checked="checked"');
                   2330:             }
                   2331:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2332:                                                       : $tempkey)
1.536     raeburn  2333:                      .'</label></span><br />'."\n");
1.465     amueller 2334:         }
1.536     raeburn  2335:         $r->print('</div>');
1.465     amueller 2336:     }
1.536     raeburn  2337:     $r->print("\n");
1.453     schualex 2338: }
1.562     damieng  2339: 
                   2340: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2341: #
1.562     damieng  2342: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2343: sub shortCuts {
1.581     raeburn  2344:     my ($r)=@_;
1.453     schualex 2345: 
1.491     bisitz   2346:     # Parameter Selection
                   2347:     $r->print(
                   2348:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2349:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2350:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2351:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2352:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2353:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2354:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2355:        .&Apache::lonhtmlcommon::end_funclist()
                   2356:     );
                   2357: 
                   2358:     # Add Selection for...
                   2359:     $r->print(
                   2360:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2361:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2362:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2363:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2364:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2365:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2366:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2367:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2368:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2369:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2370:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2371:        .&Apache::lonhtmlcommon::end_funclist()
                   2372:     );
1.208     www      2373: }
                   2374: 
1.562     damieng  2375: # Prints HTML to select parts to view (except for the title).
                   2376: # Used by table and overview modes.
                   2377: #
                   2378: # @param {Apache2::RequestRec} $r - the Apache request
                   2379: # @param {hash reference} $allparts - hash parameter part -> part title
                   2380: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2381: sub partmenu {
1.446     bisitz   2382:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2383:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2384:     if ($selsize > 8) {
                   2385:         $selsize = 8;
                   2386:     }
1.446     bisitz   2387: 
1.523     raeburn  2388:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2389:     $r->print('<option value="all"');
1.562     damieng  2390:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2391:     $r->print('>'.&mt('All Parts').'</option>');
                   2392:     my %temphash=();
                   2393:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2394:     foreach my $tempkey (sort {
1.560     damieng  2395:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2396:             } keys(%{$allparts})) {
                   2397:         unless ($tempkey =~ /\./) {
                   2398:             $r->print('<option value="'.$tempkey.'"');
                   2399:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2400:                 $r->print(' selected="selected"');
                   2401:             }
                   2402:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2403:         }
1.208     www      2404:     }
1.446     bisitz   2405:     $r->print('</select>');
1.209     www      2406: }
                   2407: 
1.562     damieng  2408: # Prints HTML to select a user and/or a group.
                   2409: # Used by table mode.
                   2410: #
                   2411: # @param {Apache2::RequestRec} $r - the Apache request
                   2412: # @param {string} $uname - selected user name
                   2413: # @param {string} $id - selected Student/Employee ID
                   2414: # @param {string} $udom - selected user domain
                   2415: # @param {string} $csec - selected section name
                   2416: # @param {string} $cgroup - selected group name
                   2417: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2418: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2419: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2420: sub usermenu {
1.553     raeburn  2421:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2422:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2423:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2424:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2425: 
1.209     www      2426:     my $sections='';
1.300     albertel 2427:     my %sectionhash = &Apache::loncommon::get_sections();
                   2428: 
1.269     raeburn  2429:     my $groups;
1.553     raeburn  2430:     my %grouphash;
                   2431:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2432:         %grouphash = &Apache::longroup::coursegroups();
                   2433:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2434:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2435:     }
1.299     albertel 2436: 
1.412     bisitz   2437:     my $g_s_header='';
                   2438:     my $g_s_footer='';
1.446     bisitz   2439: 
1.552     raeburn  2440:     my $currsec = $env{'request.course.sec'};
                   2441:     if ($currsec) {
                   2442:         $sections=&mt('Section:').' '.$currsec;
                   2443:         if (%grouphash) {
                   2444:             $sections .= ';'.('&nbsp;' x2);
                   2445:         }
                   2446:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2447:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2448:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2449:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2450:         }
                   2451:         $sections .= '>';
1.548     raeburn  2452:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2453:         $sections.='<option value="'.$section.'" '.
                   2454:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2455:                                                               '</option>';
1.209     www      2456:         }
                   2457:         $sections.='</select>';
1.269     raeburn  2458:     }
1.412     bisitz   2459: 
1.552     raeburn  2460:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2461:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2462:         $sections .= qq|
                   2463: <script type="text/javascript">
1.454     bisitz   2464: // <![CDATA[
1.269     raeburn  2465: function group_or_section(caller) {
                   2466:    if (caller == "cgroup") {
                   2467:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2468:            document.parmform.csec.selectedIndex = 0;
                   2469:        }
                   2470:    } else {
                   2471:        if (document.parmform.csec.selectedIndex != 0) {
                   2472:            document.parmform.cgroup.selectedIndex = 0;
                   2473:        }
                   2474:    }
                   2475: }
1.454     bisitz   2476: // ]]>
1.269     raeburn  2477: </script>
                   2478: |;
1.554     raeburn  2479:     } else {
1.269     raeburn  2480:         $sections .= qq|
                   2481: <script type="text/javascript">
1.454     bisitz   2482: // <![CDATA[
1.269     raeburn  2483: function group_or_section(caller) {
                   2484:     return;
                   2485: }
1.454     bisitz   2486: // ]]>
1.269     raeburn  2487: </script>
                   2488: |;
1.446     bisitz   2489:     }
1.299     albertel 2490: 
                   2491:     if (%grouphash) {
1.412     bisitz   2492:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2493:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2494:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2495:         }
                   2496:         $groups .= '>';
1.548     raeburn  2497:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2498:             $groups.='<option value="'.$grp.'" ';
                   2499:             if ($grp eq $cgroup) {
                   2500:                 unless ((defined($uname)) && ($grp eq '')) {
                   2501:                     $groups .=  'selected="selected" ';
                   2502:                 }
                   2503:             } elsif (!defined($cgroup)) {
                   2504:                 if (@{$usersgroups} == 1) {
                   2505:                     if ($grp eq $$usersgroups[0]) {
                   2506:                         $groups .=  'selected="selected" ';
                   2507:                     }
                   2508:                 }
                   2509:             }
                   2510:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2511:         }
                   2512:         $groups.='</select>';
                   2513:     }
1.412     bisitz   2514: 
1.445     neumanie 2515:     if (%sectionhash || %grouphash) {
1.446     bisitz   2516:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2517:         $r->print($sections.$groups);
1.448     bisitz   2518:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2519:     } else {
                   2520:         $r->print($sections); 
1.445     neumanie 2521:     }
1.446     bisitz   2522: 
                   2523:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2524:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2525:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2526:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2527:                  ,$chooseopt));
1.209     www      2528: }
                   2529: 
1.562     damieng  2530: # Prints HTML to select parameters from a list of all parameters.
                   2531: # Uses parmmenu and parmboxes.
                   2532: # Used by table and overview modes.
1.468     amueller 2533: #
1.562     damieng  2534: # @param {Apache2::RequestRec} $r - the Apache request
                   2535: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2536: # @param {array reference} $pscat - list of selected parameter names
                   2537: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2538: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2539: sub displaymenu {
1.581     raeburn  2540:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2541: 
1.445     neumanie 2542:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2543:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2544: 
1.581     raeburn  2545:     &parmmenu($r);
1.536     raeburn  2546:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2547:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2548:     $r->print(&Apache::loncommon::end_scrollbox());
                   2549: 
                   2550:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2551:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2552:  
1.209     www      2553: }
                   2554: 
1.562     damieng  2555: # Prints HTML to select a map.
                   2556: # Used by table mode and overview mode.
                   2557: #
                   2558: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2559: # @param {hash reference} $allmaps - hash map pc -> map src
                   2560: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2561: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2562: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2563: sub mapmenu {
1.499     raeburn  2564:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2565:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2566:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2567:     my $tree=[];
                   2568:     my $treeinfo={};
                   2569:     if (defined($navmap)) {
1.499     raeburn  2570:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2571:         my $curRes;
                   2572:         my $depth = 0;
1.468     amueller 2573:         my %parent = ();
                   2574:         my $startcount = 5;
                   2575:         my $lastcontainer = $startcount;
                   2576: # preparing what is to show ...
1.461     neumanie 2577:         while ($curRes = $it->next()) {
                   2578:             if ($curRes == $it->BEGIN_MAP()) {
                   2579:                 $depth++;
1.468     amueller 2580:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2581:             }
                   2582:             if ($curRes == $it->END_MAP()) {
                   2583:                 $depth--;
1.468     amueller 2584:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2585:             }
                   2586:             if (ref($curRes)) {
1.468     amueller 2587:                 my $symb = $curRes->symb();
                   2588:                 my $ressymb = $symb;
1.461     neumanie 2589:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2590:                     my $type = 'sequence';
                   2591:                     if ($curRes->is_page()) {
                   2592:                         $type = 'page';
                   2593:                     }
                   2594:                     my $id= $curRes->id();
1.468     amueller 2595:                     my $srcf = $curRes->src();
                   2596:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2597:                     if(!exists($treeinfo->{$id})) {
                   2598:                         push(@$tree,$id);
1.473     amueller 2599:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2600:                         $treeinfo->{$id} = {
1.461     neumanie 2601:                                     depth => $depth,
                   2602:                                     type  => $type,
1.468     amueller 2603:                                     name  => $resource_name,
                   2604:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2605:                                     };
1.462     neumanie 2606:                     }
1.461     neumanie 2607:                 }
                   2608:             }
                   2609:         }
1.462     neumanie 2610:     }
1.473     amueller 2611: # Show it ...    
1.484     amueller 2612:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2613:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2614:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2615:         my $whitespace =
                   2616:             '<img src="'
                   2617:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2618:            .'" alt="" />';
                   2619: 
1.498     bisitz   2620:         # Info about selectable folders/maps
                   2621:         $r->print(
                   2622:             '<div class="LC_info">'
1.508     www      2623:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2624:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2625:            .'</div>'
                   2626:         );
                   2627: 
1.536     raeburn  2628:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2629:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2630: 
1.498     bisitz   2631:         # Display row: "All Maps or Folders"
                   2632:         $r->print(
1.523     raeburn  2633:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2634:            .'<td>'
                   2635:            .'<label>'
                   2636:            .'<input type="radio" name="pschp"'
1.497     bisitz   2637:         );
                   2638:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2639:         $r->print(
                   2640:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2641:            .&mt('All Maps or Folders')
                   2642:            .'</label>'
                   2643:            .'<hr /></td>'
                   2644:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2645:         );
1.497     bisitz   2646: 
1.532     raeburn  2647:         # Display row: "Main Content"
1.468     amueller 2648:         if (exists($$allmaps{1})) {
1.498     bisitz   2649:             $r->print(
                   2650:                 &Apache::loncommon::start_data_table_row()
                   2651:                .'<td>'
                   2652:                .'<label>'
                   2653:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2654:             );
1.497     bisitz   2655:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2656:             $r->print(
                   2657:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2658:                .$$maptitles{1}
                   2659:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2660:                .'</label>'
                   2661:                .'</td>'
                   2662:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2663:             );
                   2664:         }
1.497     bisitz   2665: 
                   2666:         # Display rows for all course maps and folders
1.468     amueller 2667:         foreach my $id (@{$tree}) {
                   2668:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2669:             # Indentation
1.468     amueller 2670:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2671:             my $indent;
                   2672:             for (my $i = 0; $i < $depth; $i++) {
                   2673:                 $indent.= $whitespace;
                   2674:             }
1.461     neumanie 2675:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2676:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2677:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2678:             }
1.468     amueller 2679:             my $symb_name = $$symbp{$id};
                   2680:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2681:             $symb_name = $tail;
1.498     bisitz   2682:             $r->print(
                   2683:                 &Apache::loncommon::start_data_table_row()
                   2684:                .'<td>'
                   2685:                .'<label>'
1.463     bisitz   2686:             );
1.498     bisitz   2687:             # Only offer radio button for folders/maps which can be parameterized
                   2688:             if ($allmaps_inverted{$symb_name}) {
                   2689:                 $r->print(
                   2690:                     '<input type ="radio" name="pschp"'
                   2691:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2692:                 );
                   2693:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2694:                 $r->print('/>');
                   2695:             } else {
                   2696:                 $r->print($whitespace);
1.461     neumanie 2697:             }
1.498     bisitz   2698:             $r->print(
                   2699:                 $indent.$icon.'&nbsp;'
                   2700:                .$treeinfo->{$id}->{name}
                   2701:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2702:                .'</label>'
                   2703:                .'</td>'
                   2704:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2705:             );
1.461     neumanie 2706:         }
1.497     bisitz   2707: 
1.523     raeburn  2708:         $r->print(&Apache::loncommon::end_data_table().
                   2709:                   '<br style="line-height:2px;" />'.
                   2710:                   &Apache::loncommon::end_scrollbox());
1.209     www      2711:     }
                   2712: }
                   2713: 
1.563     damieng  2714: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2715: # Used by table and overview modes.
                   2716: #
                   2717: # @param {Apache2::RequestRec} $r - the Apache request
                   2718: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2719: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2720: sub levelmenu {
1.446     bisitz   2721:     my ($r,$alllevs,$parmlev)=@_;
                   2722: 
1.548     raeburn  2723:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2724:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2725:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2726:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2727:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2728:         if ($parmlev eq $$alllevs{$lev}) {
                   2729:             $r->print(' selected="selected"');
                   2730:         }
                   2731:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2732:     }
1.446     bisitz   2733:     $r->print("</select>");
1.208     www      2734: }
                   2735: 
1.211     www      2736: 
1.563     damieng  2737: # Returns HTML to select a section (with a select HTML element).
                   2738: # Used by overview mode.
                   2739: #
                   2740: # @param {array reference} $selectedsections - list of selected section ids
                   2741: # @returns {string}
1.211     www      2742: sub sectionmenu {
1.553     raeburn  2743:     my ($selectedsections)=@_;
1.300     albertel 2744:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2745:     return '' if (!%sectionhash);
1.300     albertel 2746: 
1.552     raeburn  2747:     my (@possibles,$disabled);
                   2748:     if ($env{'request.course.sec'} ne '') {
                   2749:         @possibles = ($env{'request.course.sec'});
                   2750:         $selectedsections = [$env{'request.course.sec'}];
                   2751:         $disabled = ' disabled="disabled"';
                   2752:     } else {
                   2753:         @possibles = ('all',sort(keys(%sectionhash)));
                   2754:     }
1.553     raeburn  2755:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2756:     foreach my $s (@possibles) {
1.553     raeburn  2757:         $output .= '    <option value="'.$s.'"';
                   2758:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2759:             $output .= ' selected="selected"';
1.473     amueller 2760:         }
1.553     raeburn  2761:         $output .= '>'."$s</option>\n";
1.300     albertel 2762:     }
1.553     raeburn  2763:     $output .= "</select>\n";
                   2764:     return $output;
1.269     raeburn  2765: }
                   2766: 
1.563     damieng  2767: # Returns HTML to select a group (with a select HTML element).
                   2768: # Used by overview mode.
                   2769: #
                   2770: # @param {array reference} $selectedgroups - list of selected group names
                   2771: # @returns {string}
1.269     raeburn  2772: sub groupmenu {
1.553     raeburn  2773:     my ($selectedgroups)=@_;
                   2774:     my %grouphash;
                   2775:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2776:         %grouphash = &Apache::longroup::coursegroups();
                   2777:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2778:          map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2779:     }
                   2780:     return '' if (!%grouphash);
1.299     albertel 2781: 
1.553     raeburn  2782:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2783:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2784:         $output .= '    <option value="'.$group.'"';
                   2785:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2786:             $output .=  ' selected="selected"';
1.473     amueller 2787:         }
1.553     raeburn  2788:         $output .= '>'."$group</option>\n";
1.211     www      2789:     }
1.553     raeburn  2790:     $output .= "</select>\n";
                   2791:     return $output;
1.211     www      2792: }
                   2793: 
1.563     damieng  2794: # Returns an array with the given parameter split by comma.
                   2795: # Used by assessparms (table mode).
                   2796: #
                   2797: # @param {string} $keyp - the string to split
                   2798: # @returns {Array<string>}
1.210     www      2799: sub keysplit {
                   2800:     my $keyp=shift;
                   2801:     return (split(/\,/,$keyp));
                   2802: }
                   2803: 
1.563     damieng  2804: # Returns the keys in $name, sorted using $keyorder.
                   2805: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2806: # Used by assessparms (table mode) for resource level.
                   2807: #
                   2808: # @param {hash reference} $name - parameter key -> parameter name
                   2809: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2810: # @returns {Array<string>}
1.210     www      2811: sub keysinorder {
                   2812:     my ($name,$keyorder)=@_;
                   2813:     return sort {
1.560     damieng  2814:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2815:     } (keys(%{$name}));
1.210     www      2816: }
                   2817: 
1.563     damieng  2818: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2819: # Used by assessparms (table mode) for map and general levels.
                   2820: #
                   2821: # @param {hash reference} $name - parameter key -> parameter name
                   2822: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2823: # @returns {Array<string>}
1.236     albertel 2824: sub keysinorder_bytype {
                   2825:     my ($name,$keyorder)=@_;
                   2826:     return sort {
1.563     damieng  2827:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2828:         my $tb=(split('_',$b))[-1];
                   2829:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2830:             return ($a cmp $b);
                   2831:         }
                   2832:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2833:     } (keys(%{$name}));
1.236     albertel 2834: }
                   2835: 
1.563     damieng  2836: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2837: # Used by defaultsetter (parameter settings default actions).
                   2838: #
                   2839: # @param {hash reference} $name - hash parameter name -> parameter title
                   2840: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2841: # @returns {Array<string>}
1.211     www      2842: sub keysindisplayorder {
                   2843:     my ($name,$keyorder)=@_;
                   2844:     return sort {
1.560     damieng  2845:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2846:     } (keys(%{$name}));
1.211     www      2847: }
                   2848: 
1.563     damieng  2849: # Prints HTML with a choice to sort results by realm or student first.
                   2850: # Used by overview mode.
                   2851: #
                   2852: # @param {Apache2::RequestRec} $r - the Apache request
                   2853: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2854: sub sortmenu {
                   2855:     my ($r,$sortorder)=@_;
1.236     albertel 2856:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2857:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2858:        $r->print(' checked="checked"');
1.214     www      2859:     }
                   2860:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2861:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2862:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2863:        $r->print(' checked="checked"');
1.214     www      2864:     }
1.236     albertel 2865:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2866:           '</label>');
1.214     www      2867: }
                   2868: 
1.563     damieng  2869: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2870: #
                   2871: # @returns {hash}
1.211     www      2872: sub standardkeyorder {
                   2873:     return ('parameter_0_opendate' => 1,
1.473     amueller 2874:         'parameter_0_duedate' => 2,
                   2875:         'parameter_0_answerdate' => 3,
                   2876:         'parameter_0_interval' => 4,
                   2877:         'parameter_0_weight' => 5,
                   2878:         'parameter_0_maxtries' => 6,
                   2879:         'parameter_0_hinttries' => 7,
                   2880:         'parameter_0_contentopen' => 8,
                   2881:         'parameter_0_contentclose' => 9,
                   2882:         'parameter_0_type' => 10,
                   2883:         'parameter_0_problemstatus' => 11,
                   2884:         'parameter_0_hiddenresource' => 12,
                   2885:         'parameter_0_hiddenparts' => 13,
                   2886:         'parameter_0_display' => 14,
                   2887:         'parameter_0_ordered' => 15,
                   2888:         'parameter_0_tol' => 16,
                   2889:         'parameter_0_sig' => 17,
                   2890:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2891:         'parameter_0_discussend' => 19,
                   2892:         'parameter_0_discusshide' => 20,
                   2893:         'parameter_0_discussvote' => 21,
1.560     damieng  2894:         'parameter_0_printstartdate'  =>  22,
                   2895:         'parameter_0_printenddate' =>  23);
1.211     www      2896: }
                   2897: 
1.59      matthew  2898: 
1.560     damieng  2899: # Table mode UI.
1.563     damieng  2900: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2901: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2902: #
                   2903: # Parameters used from the request:
                   2904: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2905: # cgroup - selected group
                   2906: # command - 'set': direct access to table mode for a resource
                   2907: # csec - selected section
                   2908: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2909: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2910: # id - student/employee ID
                   2911: # parmlev - selected level (full|map|general)
                   2912: # part - selected part (unused ?)
                   2913: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2914: # pres_type - &&&-separated parameter types
                   2915: # pres_value - &&&-separated parameter values
                   2916: # prevvisit - '1' if the user has submitted the form before
                   2917: # pscat (multiple values) - selected parameter names
1.566     damieng  2918: # pschp - selected map pc, or 'all'
1.563     damieng  2919: # psprt (multiple values) - list of selected parameter parts
                   2920: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2921: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2922: # symb - resource symb (when a single resource is selected)
                   2923: # udom - selected user domain
                   2924: # uname - selected user name
                   2925: # url - used only with command 'set', the resource url
                   2926: #
                   2927: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2928: # @param $parm_permission - ref to hash of permissions
                   2929: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2930: sub assessparms {
1.1       www      2931: 
1.568     raeburn  2932:     my ($r,$parm_permission) = @_;
1.201     www      2933: 
1.512     foxr     2934: 
                   2935: # -------------------------------------------------------- Variable declaration
1.566     damieng  2936:     my @ids=(); # resource and map ids
                   2937:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2938:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2939:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2940:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2941:     my %uris=(); # hash resource/map id -> resource src
                   2942:     my %maptitles=(); # hash map pc or src -> map title
                   2943:     my %allmaps=(); # hash map pc -> map src
1.582     raeburn  2944:     my %allmaps_inverted=(); # hash map src -> map pc
1.563     damieng  2945:     my %alllevs=(); # hash English level title -> value
                   2946: 
                   2947:     my $uname; # selected user name
                   2948:     my $udom; # selected user domain
                   2949:     my $uhome; # server with the user's files, or 'no_host'
                   2950:     my $csec; # selected section name
                   2951:     my $cgroup; # selected group name
                   2952:     my @usersgroups = (); # list of the user groups
1.582     raeburn  2953:     my $numreclinks = 0;
1.446     bisitz   2954: 
1.190     albertel 2955:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2956: 
1.57      albertel 2957:     $alllevs{'Resource Level'}='full';
1.215     www      2958:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2959:     $alllevs{'Course Level'}='general';
                   2960: 
1.563     damieng  2961:     my %allparms; # hash parameter name -> parameter title
                   2962:     my %allparts; # hash parameter part -> part title
1.512     foxr     2963: # ------------------------------------------------------------------------------
                   2964: 
1.210     www      2965: #
                   2966: # Order in which these parameters will be displayed
                   2967: #
1.211     www      2968:     my %keyorder=&standardkeyorder();
                   2969: 
1.512     foxr     2970: #    @ids=();
                   2971: #    %symbp=();       # These seem defined above already.
                   2972: #    %typep=();
1.43      albertel 2973: 
                   2974:     my $message='';
                   2975: 
1.190     albertel 2976:     $csec=$env{'form.csec'};
1.552     raeburn  2977:     if ($env{'request.course.sec'} ne '') {
                   2978:         $csec = $env{'request.course.sec'};    
                   2979:     }
                   2980: 
1.553     raeburn  2981: # Check group privs.
1.269     raeburn  2982:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2983:     my $noeditgrp; 
                   2984:     if ($cgroup ne '') {
                   2985:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2986:             if (($env{'request.course.groups'} eq '') || 
1.585     raeburn  2987:                 (!grep(/^\Q$cgroup\E$/,split(/:/,$env{'request.course.groups'})))) {
1.553     raeburn  2988:                 $noeditgrp = 1;
                   2989:             }
                   2990:         }
                   2991:     }
1.188     www      2992: 
1.190     albertel 2993:     if      ($udom=$env{'form.udom'}) {
                   2994:     } elsif ($udom=$env{'request.role.domain'}) {
                   2995:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2996:     } else {
1.473     amueller 2997:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2998:     }
1.468     amueller 2999:     
1.43      albertel 3000: 
1.134     albertel 3001:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 3002:     my $pschp=$env{'form.pschp'};
1.506     www      3003: 
                   3004: 
1.134     albertel 3005:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      3006:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      3007:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 3008: 
1.43      albertel 3009:     my $pssymb='';
1.57      albertel 3010:     my $parmlev='';
1.446     bisitz   3011: 
1.190     albertel 3012:     unless ($env{'form.parmlev'}) {
1.57      albertel 3013:         $parmlev = 'map';
                   3014:     } else {
1.190     albertel 3015:         $parmlev = $env{'form.parmlev'};
1.57      albertel 3016:     }
1.26      www      3017: 
1.29      www      3018: # ----------------------------------------------- Was this started from grades?
                   3019: 
1.560     damieng  3020:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   3021:             (!$env{'form.dis'})) {
1.473     amueller 3022:         my $url=$env{'form.url'};
                   3023:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   3024:         $pssymb=&Apache::lonnet::symbread($url);
                   3025:         if (!@pscat) { @pscat=('all'); }
                   3026:         $pschp='';
1.57      albertel 3027:         $parmlev = 'full';
1.190     albertel 3028:     } elsif ($env{'form.symb'}) {
1.473     amueller 3029:         $pssymb=$env{'form.symb'};
                   3030:         if (!@pscat) { @pscat=('all'); }
                   3031:         $pschp='';
1.57      albertel 3032:         $parmlev = 'full';
1.43      albertel 3033:     } else {
1.473     amueller 3034:         $env{'form.url'}='';
1.43      albertel 3035:     }
                   3036: 
1.190     albertel 3037:     my $id=$env{'form.id'};
1.43      albertel 3038:     if (($id) && ($udom)) {
1.555     raeburn  3039:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 3040:         if ($uname) {
                   3041:             $id='';
                   3042:         } else {
                   3043:             $message=
1.540     bisitz   3044:                 '<p class="LC_warning">'.
                   3045:                 &mt('Unknown ID [_1] at domain [_2]',
                   3046:                     "'".$id."'","'".$udom."'").
                   3047:                 '</p>';
1.473     amueller 3048:         }
1.43      albertel 3049:     } else {
1.473     amueller 3050:         $uname=$env{'form.uname'};
1.43      albertel 3051:     }
                   3052:     unless ($udom) { $uname=''; }
                   3053:     $uhome='';
                   3054:     if ($uname) {
1.473     amueller 3055:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 3056:         if ($uhome eq 'no_host') {
1.473     amueller 3057:             $message=
1.540     bisitz   3058:                 '<p class="LC_warning">'.
                   3059:                 &mt('Unknown user [_1] at domain [_2]',
                   3060:                     "'".$uname."'","'".$udom."'").
                   3061:                 '</p>';
1.473     amueller 3062:             $uname='';
1.12      www      3063:         } else {
1.473     amueller 3064:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   3065:                           $env{'request.course.id'});
                   3066:             if ($csec eq '-1') {
1.540     bisitz   3067:                 $message=
                   3068:                     '<p class="LC_warning">'.
                   3069:                     &mt('User [_1] at domain [_2] not in this course',
                   3070:                         "'".$uname."'","'".$udom."'").
                   3071:                     '</p>';
1.473     amueller 3072:                 $uname='';
1.594     raeburn  3073:                 if ($env{'request.course.sec'} ne '') {
                   3074:                     $csec=$env{'request.course.sec'};
                   3075:                 } else {
                   3076:                     $csec=$env{'form.csec'};
                   3077:                 }
                   3078:                 $cgroup=$env{'form.cgroup'};
                   3079:             } elsif ($env{'request.course.sec'} ne '') {
                   3080:                 if ($csec ne $env{'request.course.sec'}) {
                   3081:                     $message='<span class="LC_error">'.
                   3082:                               &mt("User '[_1]' at domain '[_2]' not in section '[_3]'",
                   3083:                                   $uname,$udom,$env{'request.course.sec'}).
                   3084:                               '</span>';
                   3085:                     $uname='';
                   3086:                     $csec=$env{'request.course.sec'};
                   3087:                 }
1.269     raeburn  3088:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 3089:             } else {
                   3090:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   3091:                   ('firstname','middlename','lastname','generation','id'));
                   3092:                 $message="\n<p>\n".&mt("Full Name").": ".
                   3093:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   3094:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   3095:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 3096:             }
1.297     raeburn  3097:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  3098:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  3099:             if (@usersgroups > 0) {
1.306     albertel 3100:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  3101:                     $cgroup = $usersgroups[0];
1.297     raeburn  3102:                 }
1.269     raeburn  3103:             }
1.12      www      3104:         }
1.43      albertel 3105:     }
1.2       www      3106: 
1.43      albertel 3107:     unless ($csec) { $csec=''; }
1.269     raeburn  3108:     unless ($cgroup) { $cgroup=''; }
1.12      www      3109: 
1.14      www      3110: # --------------------------------------------------------- Get all assessments
1.446     bisitz   3111:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3112:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3113:                 \%keyorder);
1.63      bowersj2 3114: 
1.582     raeburn  3115:     %allmaps_inverted = reverse(%allmaps);
                   3116: 
1.57      albertel 3117:     $mapp{'0.0'} = '';
                   3118:     $symbp{'0.0'} = '';
1.99      albertel 3119: 
1.14      www      3120: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  3121:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      3122:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   3123:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   3124:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  3125:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3126:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  3127:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   3128:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   3129:         my $totalstored = 0;
1.546     raeburn  3130:         my $now = time;
1.473     amueller 3131:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  3132:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  3133:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  3134:                 next if ($csec ne $env{'request.course.sec'});
                   3135:             }
1.556     raeburn  3136:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  3137:                 next if ($noeditgrp);
1.557     raeburn  3138:             }
                   3139:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   3140:                 $namematch = 'maplevelrecurse';
                   3141:             }
1.556     raeburn  3142:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  3143:                 my (@ok_slots,@fail_slots,@del_slots);
                   3144:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   3145:                 my ($level,@all) =
                   3146:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   3147:                                      $csec,$cgroup,$courseopt);
                   3148:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   3149:                     next if ($slot_name eq '');
                   3150:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   3151:                         push(@ok_slots,$slot_name);
                   3152: 
                   3153:                     } else {
                   3154:                         push(@fail_slots,$slot_name);
                   3155:                     }
                   3156:                 }
                   3157:                 if (@ok_slots) {
                   3158:                     $values[$i] = join(':',@ok_slots);
                   3159:                 } else {
                   3160:                     $values[$i] = '';
                   3161:                 }
                   3162:                 if ($all[$level] ne '') {
                   3163:                     my @existing = split(/:/,$all[$level]);
                   3164:                     foreach my $slot_name (@existing) {
                   3165:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   3166:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   3167:                                 push(@del_slots,$slot_name);
                   3168:                             }
                   3169:                         }
                   3170:                     }
                   3171:                 }
1.554     raeburn  3172:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  3173:                 $name = $1;
1.533     raeburn  3174:                 my $val = $values[$i];
1.549     raeburn  3175:                 my $valmatch = '';
1.533     raeburn  3176:                 if ($name eq 'examcode') {
1.544     raeburn  3177:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   3178:                         $val = 'valid';
                   3179:                     }
1.546     raeburn  3180:                 } elsif ($name eq 'printstartdate') {
                   3181:                     if ($val =~ /^\d+$/) {
                   3182:                         if ($val > $now) {
                   3183:                             $val = 'future';
                   3184:                         }
                   3185:                     } 
                   3186:                 } elsif ($name eq 'printenddate') {
                   3187:                     if ($val =~ /^\d+$/) {
                   3188:                         if ($val < $now) {
                   3189:                             $val = 'past';
                   3190:                         }
                   3191:                     }
1.549     raeburn  3192:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   3193:                     my $stringtype = &get_stringtype($name);
                   3194:                     my $stringmatch = &standard_string_matches($stringtype);
                   3195:                     if (ref($stringmatch) eq 'ARRAY') {
                   3196:                         foreach my $item (@{$stringmatch}) {
                   3197:                             if (ref($item) eq 'ARRAY') {
                   3198:                                 my ($regexpname,$pattern) = @{$item};
                   3199:                                 if ($pattern ne '') {
                   3200:                                     if ($val =~ /$pattern/) {
                   3201:                                         $valmatch = $regexpname;
                   3202:                                         $val = '';
                   3203:                                         last;
                   3204:                                     }
                   3205:                                 }
                   3206:                             }
                   3207:                         }
                   3208:                     }
1.554     raeburn  3209:                 } elsif ($name eq 'interval') {
                   3210:                     my $intervaltype = &get_intervaltype($name);
                   3211:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   3212:                     if (ref($intervalmatch) eq 'ARRAY') {
                   3213:                         foreach my $item (@{$intervalmatch}) {
                   3214:                             if (ref($item) eq 'ARRAY') {
                   3215:                                 my ($regexpname,$pattern) = @{$item};
                   3216:                                 if ($pattern ne '') {
                   3217:                                     if ($val =~ /$pattern/) {
                   3218:                                         $valmatch = $regexpname;
                   3219:                                         $val = '';
                   3220:                                         last;
                   3221:                                     }
                   3222:                                 }
                   3223:                             }
                   3224:                         }
                   3225:                     }
1.533     raeburn  3226:                 }
1.504     raeburn  3227:                 $needsrelease =
1.557     raeburn  3228:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  3229:                 if ($needsrelease) {
1.505     raeburn  3230:                     unless ($got_chostname) {
1.514     raeburn  3231:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  3232:                         $got_chostname = 1;
1.546     raeburn  3233:                     } 
1.557     raeburn  3234:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  3235:                                                           $needsrelease,
                   3236:                                                           $cmajor,$cminor);
1.500     raeburn  3237:                 }
1.437     raeburn  3238:             }
1.504     raeburn  3239:             if ($needsnewer) {
1.557     raeburn  3240:                 undef($namematch);
                   3241:             } else {
                   3242:                 my $currneeded;
                   3243:                 if ($needsrelease) {
                   3244:                     $currneeded = $needsrelease;
                   3245:                 }
                   3246:                 if ($namematch) {
                   3247:                     $needsrelease =
                   3248:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3249:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3250:                         unless ($got_chostname) {
                   3251:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3252:                             $got_chostname = 1;
                   3253:                         }
                   3254:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3255:                                                               $needsrelease,
                   3256:                                                               $cmajor,$cminor);
                   3257:                     } else {
                   3258:                         undef($namematch);
                   3259:                     }
                   3260:                 }
                   3261:             }
                   3262:             if ($needsnewer) {
                   3263:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3264:                                                 $cminor,$needsrelease);
                   3265:             } else {
                   3266:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3267:                                      $values[$i],
                   3268:                                      $types[$i],
                   3269:                                      $uname,$udom,$csec,$cgroup);
                   3270:                 $totalstored ++;
                   3271:             }
1.473     amueller 3272:         }
1.68      www      3273: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3274:         if ($totalstored) {
                   3275:             $message.='<p class="LC_warning">'
                   3276:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3277:                      .&Apache::loncommon::help_open_topic('Caching')
                   3278:                      .'</p>';
                   3279:         }
1.68      www      3280:     }
1.584     raeburn  3281: 
1.57      albertel 3282: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3283:     if ($pscat[0] eq "all") {
                   3284:         @pscat = (keys(%allparms));
                   3285:     }
                   3286:     if (!@pscat) {
                   3287:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3288:     };
                   3289:     if ($psprt[0] eq "all" || !@psprt) {
                   3290:         @psprt = (keys(%allparts));
                   3291:     }
1.2       www      3292: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3293: 
1.531     raeburn  3294:     my $crstype = &Apache::loncommon::course_type();
                   3295:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3296: 
1.548     raeburn  3297:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.589     raeburn  3298:             'date_interval','int','float','string','string_lenient',
                   3299:             'string_examcode','string_deeplink','string_discussvote',
                   3300:             'string_useslots','string_problemstatus','string_ip',
                   3301:             'string_questiontype') {
1.473     amueller 3302:         $r->print('<input type="hidden" value="'.
1.563     damieng  3303:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3304:             '" name="recent_'.$item.'" />');
1.44      albertel 3305:     }
1.446     bisitz   3306: 
1.459     bisitz   3307:     # ----- Start Parameter Selection
                   3308: 
                   3309:     # Hide parm selection?
                   3310:     $r->print(<<ENDPARMSELSCRIPT);
                   3311: <script type="text/javascript">
                   3312: // <![CDATA[
                   3313: function parmsel_show() {
1.562     damieng  3314:     document.getElementById('parmsel').style.display = "";
                   3315:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3316: }
                   3317: // ]]>
                   3318: </script>
                   3319: ENDPARMSELSCRIPT
1.474     amueller 3320:     
1.445     neumanie 3321:     if (!$pssymb) {
1.563     damieng  3322:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3323:         my $parmselhiddenstyle=' style="display:none"';
                   3324:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3325:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3326:         } else  {
                   3327:            $r->print('<div id="parmsel">');
                   3328:         }
                   3329: 
1.491     bisitz   3330:         # Step 1
1.523     raeburn  3331:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3332:         $r->print('
1.474     amueller 3333: <script type="text/javascript">
1.523     raeburn  3334: // <![CDATA['.
                   3335:                  &showhide_js().'
1.474     amueller 3336: // ]]>
                   3337: </script>
1.523     raeburn  3338: ');
                   3339:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3340:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3341:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3342:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3343:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3344:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3345:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3346:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3347:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3348: 
                   3349:         # Step 2
1.523     raeburn  3350:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581     raeburn  3351:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3352: 
                   3353:         # Step 3
1.523     raeburn  3354:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3355:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3356:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3357:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3358:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3359: 
                   3360:         # Update Display Button
1.486     www      3361:         $r->print('<p>'
                   3362:              .'<input type="submit" name="dis"'
1.511     www      3363:              .' value="'.&mt('Update Display').'" />'
1.486     www      3364:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3365:              .'</p>');
                   3366:         $r->print('</div>');
1.491     bisitz   3367: 
1.486     www      3368:         # Offer link to display parameter selection again
                   3369:         $r->print('<p id="parmsellink"');
                   3370:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3371:            $r->print($parmselhiddenstyle);
                   3372:         }
                   3373:         $r->print('>'
                   3374:              .'<a href="javascript:parmsel_show()">'
                   3375:              .&mt('Change Parameter Selection')
                   3376:              .'</a>'
                   3377:              .'</p>');
1.44      albertel 3378:     } else {
1.478     amueller 3379:         # parameter screen for a single resource. 
1.486     www      3380:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3381:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3382:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3383:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3384:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3385:                   '<br />');
                   3386:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3387:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3388:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3389:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3390:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3391:         $r->print('<p>'
1.459     bisitz   3392:              .'<input type="submit" name="dis"'
1.511     www      3393:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3394:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3395:              .'</p>');
1.459     bisitz   3396:     }
1.478     amueller 3397:     
1.486     www      3398:     # ----- End Parameter Selection
1.57      albertel 3399: 
1.459     bisitz   3400:     # Display Messages
                   3401:     $r->print('<div>'.$message.'</div>');
1.210     www      3402: 
1.57      albertel 3403: 
                   3404:     my @temp_pscat;
                   3405:     map {
                   3406:         my $cat = $_;
                   3407:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3408:     } @pscat;
                   3409: 
                   3410:     @pscat = @temp_pscat;
                   3411: 
1.548     raeburn  3412: 
1.209     www      3413:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3414: # ----------------------------------------------------------------- Start Table
1.57      albertel 3415:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3416:         my $csuname=$env{'user.name'};
                   3417:         my $csudom=$env{'user.domain'};
1.568     raeburn  3418:         my $readonly = 1;
                   3419:         if ($parm_permission->{'edit'}) {
                   3420:             undef($readonly); 
                   3421:         }
1.57      albertel 3422: 
1.203     www      3423:         if ($parmlev eq 'full') {
1.506     www      3424: #
                   3425: # This produces the cascading table output of parameters
                   3426: #
1.578     raeburn  3427:             my $coursespan=$csec?8:5;
                   3428:             my $userspan=3;
1.560     damieng  3429:             if ($cgroup ne '') {
1.578     raeburn  3430:                 $coursespan += 3;
1.560     damieng  3431:             }
1.473     amueller 3432: 
1.560     damieng  3433:             $r->print(&Apache::loncommon::start_data_table());
                   3434:             #
                   3435:             # This produces the headers
                   3436:             #
                   3437:             $r->print('<tr><td colspan="5"></td>');
                   3438:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3439:             if ($uname) {
1.473     amueller 3440:                 if (@usersgroups > 1) {
1.560     damieng  3441:                     $userspan ++;
                   3442:                 }
                   3443:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3444:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3445:             }
                   3446:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3447:                 'pie'    => "Parameter in Effect",
                   3448:                 'csv'    => "Current Session Value",
1.472     amueller 3449:                 'rl'     => "Resource Level",
1.473     amueller 3450:                 'ic'     => 'in Course',
                   3451:                 'aut'    => "Assessment URL and Title",
                   3452:                 'type'   => 'Type',
                   3453:                 'emof'   => "Enclosing Map or Folder",
                   3454:                 'part'   => 'Part',
1.472     amueller 3455:                 'pn'     => 'Parameter Name',
1.473     amueller 3456:                 'def'    => 'default',
                   3457:                 'femof'  => 'from Enclosing Map or Folder',
                   3458:                 'gen'    => 'general',
                   3459:                 'foremf' => 'for Enclosing Map or Folder',
                   3460:                 'fr'     => 'for Resource'
                   3461:             );
1.560     damieng  3462:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3463: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3464: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3465: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3466: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3467: 
1.10      www      3468: ENDTABLETWO
1.560     damieng  3469:             if ($csec) {
1.578     raeburn  3470:                 $r->print('<th colspan="3">'.
1.560     damieng  3471:                 &mt("in Section")." $csec</th>");
                   3472:             }
                   3473:             if ($cgroup) {
1.578     raeburn  3474:                 $r->print('<th colspan="3">'.
1.472     amueller 3475:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3476:             }
                   3477:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3478: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3479: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3480: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3481: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3482: ENDTABLEHEADFOUR
1.57      albertel 3483: 
1.560     damieng  3484:             if ($csec) {
1.578     raeburn  3485:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3486:             }
1.473     amueller 3487: 
1.560     damieng  3488:             if ($cgroup) {
1.578     raeburn  3489:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3490:             }
                   3491: 
                   3492:             if ($uname) {
                   3493:                 if (@usersgroups > 1) {
                   3494:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3495:                 }
1.578     raeburn  3496:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3497:             }
                   3498: 
                   3499:             $r->print('</tr>');
1.506     www      3500: #
                   3501: # Done with the headers
                   3502: # 
1.560     damieng  3503:             my $defbgone='';
                   3504:             my $defbgtwo='';
                   3505:             my $defbgthree = '';
1.57      albertel 3506: 
1.560     damieng  3507:             foreach my $rid (@ids) {
1.57      albertel 3508: 
                   3509:                 my ($inmapid)=($rid=~/\.(\d+)$/);
1.446     bisitz   3510:                 if ((!$pssymb &&
1.560     damieng  3511:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3512:                         ||
                   3513:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3514: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3515:                     if ($defbgone eq '#E0E099') {
                   3516:                         $defbgone='#E0E0DD';
1.57      albertel 3517:                     } else {
1.419     bisitz   3518:                         $defbgone='#E0E099';
1.57      albertel 3519:                     }
1.419     bisitz   3520:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3521:                         $defbgtwo='#FFFFDD';
1.57      albertel 3522:                     } else {
1.473     amueller 3523:                         $defbgtwo='#FFFF99';
1.57      albertel 3524:                     }
1.419     bisitz   3525:                     if ($defbgthree eq '#FFBB99') {
                   3526:                         $defbgthree='#FFBBDD';
1.269     raeburn  3527:                     } else {
1.419     bisitz   3528:                         $defbgthree='#FFBB99';
1.269     raeburn  3529:                     }
                   3530: 
1.57      albertel 3531:                     my $thistitle='';
                   3532:                     my %name=   ();
                   3533:                     undef %name;
                   3534:                     my %part=   ();
                   3535:                     my %display=();
                   3536:                     my %type=   ();
                   3537:                     my %default=();
1.196     www      3538:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3539:                     my $toolsymb;
                   3540:                     if ($uri =~ /ext\.tool$/) {
                   3541:                         $toolsymb = $symbp{$rid};
                   3542:                     }
1.57      albertel 3543: 
1.506     www      3544:                     my $filter=$env{'form.filter'};
1.548     raeburn  3545:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3546:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.584     raeburn  3547:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name',$toolsymb);
1.560     damieng  3548:     # We may only want certain parameters listed
                   3549:                             if ($filter) {
                   3550:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3551:                             }
                   3552:                             $name{$tempkeyp}=$parmname;
1.584     raeburn  3553:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part',$toolsymb);
1.560     damieng  3554: 
1.584     raeburn  3555:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display',$toolsymb);
1.560     damieng  3556:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3557:                                 my $identifier;
                   3558:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3559:                                     $identifier = $1;
                   3560:                                 }
                   3561:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3562:                             } else {
                   3563:                                 $display{$tempkeyp} = $parmdis;
                   3564:                             }
                   3565:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3566:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.584     raeburn  3567:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp,$toolsymb);
                   3568:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type',$toolsymb);
                   3569:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title',$toolsymb);
1.57      albertel 3570:                         }
                   3571:                     }
1.548     raeburn  3572:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3573:                     if ($totalparms>0) {
1.560     damieng  3574:                         my $firstrow=1;
1.473     amueller 3575:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.582     raeburn  3576:                         my $navmap = Apache::lonnavmaps::navmap->new();
                   3577:                         my @recurseup;
                   3578:                         if (ref($navmap) && $mapp{$rid}) {
                   3579:                             @recurseup = $navmap->recurseup_maps($mapp{$rid});
                   3580:                         }
1.419     bisitz   3581:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3582:                              ' rowspan='.$totalparms.
1.419     bisitz   3583:                              '><tt><font size="-1">'.
1.57      albertel 3584:                              join(' / ',split(/\//,$uri)).
                   3585:                              '</font></tt><p><b>'.
1.154     albertel 3586:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3587:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3588:                           &escape($symbp{$rid}).
1.336     albertel 3589:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3590:                              " target=\"_self\">$title");
1.57      albertel 3591: 
                   3592:                         if ($thistitle) {
1.473     amueller 3593:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3594:                         }
                   3595:                         $r->print('</a></b></td>');
1.419     bisitz   3596:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3597:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3598:                                       '</td>');
                   3599: 
1.419     bisitz   3600:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3601:                                       ' rowspan='.$totalparms.
1.238     www      3602:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3603:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3604:                             unless ($firstrow) {
                   3605:                                 $r->print('<tr>');
                   3606:                             } else {
                   3607:                                 undef $firstrow;
                   3608:                             }
1.548     raeburn  3609:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3610:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3611:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.582     raeburn  3612:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly,
                   3613:                                        \@recurseup,\%maptitles,\%allmaps_inverted,
                   3614:                                        \$numreclinks);
1.57      albertel 3615:                         }
                   3616:                     }
                   3617:                 }
                   3618:             } # end foreach ids
1.43      albertel 3619: # -------------------------------------------------- End entry for one resource
1.517     www      3620:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3621:         } # end of  full
1.57      albertel 3622: #--------------------------------------------------- Entry for parm level map
                   3623:         if ($parmlev eq 'map') {
1.419     bisitz   3624:             my $defbgone = '#E0E099';
                   3625:             my $defbgtwo = '#FFFF99';
                   3626:             my $defbgthree = '#FFBB99';
1.57      albertel 3627: 
                   3628:             my %maplist;
                   3629: 
                   3630:             if ($pschp eq 'all') {
1.446     bisitz   3631:                 %maplist = %allmaps;
1.57      albertel 3632:             } else {
                   3633:                 %maplist = ($pschp => $mapp{$pschp});
                   3634:             }
                   3635: 
                   3636: #-------------------------------------------- for each map, gather information
                   3637:             my $mapid;
1.560     damieng  3638:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3639:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3640: 
                   3641: #-----------------------  loop through ids and get all parameter types for map
                   3642: #-----------------------------------------          and associated information
                   3643:                 my %name = ();
                   3644:                 my %part = ();
                   3645:                 my %display = ();
                   3646:                 my %type = ();
                   3647:                 my %default = ();
                   3648:                 my $map = 0;
                   3649: 
1.473     amueller 3650: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3651: 
1.548     raeburn  3652:                 foreach my $id (@ids) {
                   3653:                     ($map)=($id =~ /([\d]*?)\./);
                   3654:                     my $rid = $id;
1.446     bisitz   3655: 
1.57      albertel 3656: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3657: 
1.560     damieng  3658:                     if ($map eq $mapid) {
1.473     amueller 3659:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3660:                         my $toolsymb;
                   3661:                         if ($uri =~ /ext\.tool$/) {
                   3662:                             $toolsymb = $symbp{$rid};
                   3663:                         }
1.582     raeburn  3664: 
1.57      albertel 3665: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3666: 
                   3667: #--------------------------------------------------------------------
                   3668: # @catmarker contains list of all possible parameters including part #s
                   3669: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3670: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3671: # When storing information, store as part 0
                   3672: # When requesting information, request from full part
                   3673: #-------------------------------------------------------------------
1.548     raeburn  3674:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3675:                             my $tempkeyp = $fullkeyp;
                   3676:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3677: 
1.548     raeburn  3678:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3679:                                 $part{$tempkeyp}="0";
1.584     raeburn  3680:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3681:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3682:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3683:                                     my $identifier;
                   3684:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3685:                                         $identifier = $1;
                   3686:                                     }
                   3687:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3688:                                 } else {
                   3689:                                     $display{$tempkeyp} = $parmdis;
                   3690:                                 }
                   3691:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3692:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3693:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3694:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3695:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.473     amueller 3696:                               }
                   3697:                         } # end loop through keys
1.560     damieng  3698:                     }
1.57      albertel 3699:                 } # end loop through ids
1.446     bisitz   3700: 
1.57      albertel 3701: #---------------------------------------------------- print header information
1.133     www      3702:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3703:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3704:                 my $tmp="";
1.57      albertel 3705:                 if ($uname) {
1.473     amueller 3706:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3707:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3708:                         &mt('in')." \n";
1.57      albertel 3709:                 } else {
1.401     bisitz   3710:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3711:                 }
1.269     raeburn  3712:                 if ($cgroup) {
1.401     bisitz   3713:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3714:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3715:                     $csec = '';
                   3716:                 } elsif ($csec) {
1.401     bisitz   3717:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3718:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3719:                 }
1.401     bisitz   3720:                 $r->print('<div align="center"><h4>'
                   3721:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3722:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3723:                              ,$tmp
                   3724:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3725:                              )
                   3726:                          ."<br /></h4>\n"
1.422     bisitz   3727:                 );
1.57      albertel 3728: #---------------------------------------------------------------- print table
1.419     bisitz   3729:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3730:                          .&Apache::loncommon::start_data_table_header_row()
                   3731:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3732:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3733:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3734:                          .&Apache::loncommon::end_data_table_header_row()
                   3735:                 );
1.57      albertel 3736: 
1.582     raeburn  3737:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   3738:                 my @recurseup;
                   3739:                 if (ref($navmap)) {
                   3740:                      my $mapres = $navmap->getByMapPc($mapid);
                   3741:                      if (ref($mapres)) {
                   3742:                          @recurseup = $navmap->recurseup_maps($mapres->src());
                   3743:                      }
                   3744:                 }
                   3745: 
                   3746: 
1.548     raeburn  3747:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3748:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3749:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3750:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3751:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
1.582     raeburn  3752:                            $readonly,\@recurseup,\%maptitles,\%allmaps_inverted,
                   3753:                            \$numreclinks);
1.57      albertel 3754:                 }
1.422     bisitz   3755:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3756:                          .'</div>'
                   3757:                 );
1.57      albertel 3758:             } # end each map
                   3759:         } # end of $parmlev eq map
                   3760: #--------------------------------- Entry for parm level general (Course level)
                   3761:         if ($parmlev eq 'general') {
1.473     amueller 3762:             my $defbgone = '#E0E099';
1.419     bisitz   3763:             my $defbgtwo = '#FFFF99';
                   3764:             my $defbgthree = '#FFBB99';
1.57      albertel 3765: 
                   3766: #-------------------------------------------- for each map, gather information
                   3767:             my $mapid="0.0";
                   3768: #-----------------------  loop through ids and get all parameter types for map
                   3769: #-----------------------------------------          and associated information
                   3770:             my %name = ();
                   3771:             my %part = ();
                   3772:             my %display = ();
                   3773:             my %type = ();
                   3774:             my %default = ();
1.446     bisitz   3775: 
1.548     raeburn  3776:             foreach $id (@ids) {
                   3777:                 my $rid = $id;
1.446     bisitz   3778: 
1.196     www      3779:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3780:                 my $toolsymb;
                   3781:                 if ($uri =~ /ext\.tool$/) {
                   3782:                     $toolsymb = $symbp{$rid};
                   3783:                 }
1.57      albertel 3784: 
                   3785: #--------------------------------------------------------------------
                   3786: # @catmarker contains list of all possible parameters including part #s
                   3787: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3788: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3789: # When storing information, store as part 0
                   3790: # When requesting information, request from full part
                   3791: #-------------------------------------------------------------------
1.548     raeburn  3792:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3793:                     my $tempkeyp = $fullkeyp;
                   3794:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3795:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3796:                         $part{$tempkeyp}="0";
1.584     raeburn  3797:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3798:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3799:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3800:                             my $identifier;
                   3801:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3802:                                 $identifier = $1;
                   3803:                             }
                   3804:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3805:                         } else {
                   3806:                             $display{$tempkeyp} = $parmdis;
                   3807:                         }
                   3808:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3809:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3810:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3811:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3812:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.560     damieng  3813:                     }
1.57      albertel 3814:                 } # end loop through keys
                   3815:             } # end loop through ids
1.446     bisitz   3816: 
1.57      albertel 3817: #---------------------------------------------------- print header information
1.473     amueller 3818:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3819:             $r->print(<<ENDMAPONE);
1.419     bisitz   3820: <center>
                   3821: <h4>$setdef
1.135     albertel 3822: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3823: ENDMAPONE
                   3824:             if ($uname) {
1.473     amueller 3825:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3826:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3827:             } else {
1.135     albertel 3828:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3829:             }
1.446     bisitz   3830: 
1.135     albertel 3831:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3832:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3833:             $r->print("</h4>\n");
1.57      albertel 3834: #---------------------------------------------------------------- print table
1.419     bisitz   3835:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3836:                      .&Apache::loncommon::start_data_table_header_row()
                   3837:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3838:                      .'<th>'.&mt('Default Value').'</th>'
                   3839:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3840:                      .&Apache::loncommon::end_data_table_header_row()
                   3841:             );
1.57      albertel 3842: 
1.548     raeburn  3843:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3844:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3845:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3846:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3847:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3848:                            $readonly);
1.57      albertel 3849:             }
1.419     bisitz   3850:             $r->print(&Apache::loncommon::end_data_table()
                   3851:                      .'</p>'
                   3852:                      .'</center>'
                   3853:             );
1.57      albertel 3854:         } # end of $parmlev eq general
1.43      albertel 3855:     }
1.507     www      3856:     $r->print('</form>');
1.582     raeburn  3857:     if ($numreclinks) {
                   3858:         $r->print(<<"END");
                   3859: <form name="recurseform" action="/adm/parmset?action=settable" method="post">
                   3860: <input type="hidden" name="pschp" />
                   3861: <input type="hidden" name="pscat" />
                   3862: <input type="hidden" name="psprt" />
                   3863: <input type="hidden" name="hideparmsel" value="hidden" />
                   3864: </form>
                   3865: <script type="text/javascript">
                   3866: function pjumprec(rid,name,part) {
                   3867:     document.forms.recurseform.pschp.value = rid;
                   3868:     document.forms.recurseform.pscat.value = name;
                   3869:     document.forms.recurseform.psprt.value = part;
                   3870:     document.forms.recurseform.submit();
                   3871:     return false;
                   3872: }
                   3873: </script>
                   3874: END
                   3875:     }
1.507     www      3876:     &endSettingsScreen($r);
                   3877:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3878: } # end sub assessparms
1.30      www      3879: 
1.560     damieng  3880: 
                   3881: 
1.120     www      3882: ##################################################
1.560     damieng  3883: # OVERVIEW MODE
1.207     www      3884: ##################################################
1.124     www      3885: 
1.563     damieng  3886: my $tableopen; # boolean, true if HTML table is already opened
                   3887: 
                   3888: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3889: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3890: # @returns {string}
1.124     www      3891: sub tablestart {
1.576     raeburn  3892:     my ($readonly,$is_map) = @_;
1.124     www      3893:     if ($tableopen) {
1.552     raeburn  3894:         return '';
1.124     www      3895:     } else {
1.552     raeburn  3896:         $tableopen=1;
                   3897:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3898:         if ($readonly) {
                   3899:             $output .= '<th>'.&mt('Current value').'</th>';
                   3900:         } else {
1.576     raeburn  3901:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3902:                        '<th>'.&mt('Set to ...').'</th>';
                   3903:             if ($is_map) {
                   3904:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3905:             }
1.552     raeburn  3906:         }
                   3907:         $output .= '</tr>';
                   3908:         return $output;
1.124     www      3909:     }
                   3910: }
                   3911: 
1.563     damieng  3912: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3913: # @returns {string}
1.124     www      3914: sub tableend {
                   3915:     if ($tableopen) {
1.560     damieng  3916:         $tableopen=0;
                   3917:         return &Apache::loncommon::end_data_table();
1.124     www      3918:     } else {
1.560     damieng  3919:         return'';
1.124     www      3920:     }
                   3921: }
                   3922: 
1.563     damieng  3923: # Reads course and user information.
                   3924: # If the context is looking for a scalar, returns the course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db) with added student data from lonnet::get_userresdata (which reads the user's resourcedata.db).
                   3925: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3926: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3927: # @param {string} $crs - course number
                   3928: # @param {string} $dom - course domain
                   3929: # @returns {hash reference|Array}
1.207     www      3930: sub readdata {
                   3931:     my ($crs,$dom)=@_;
                   3932: # Read coursedata
                   3933:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3934: # Read userdata
                   3935: 
                   3936:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3937:     foreach my $user (keys(%$classlist)) {
                   3938:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3939:             my ($tuname,$tudom)=($1,$2);
                   3940:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3941:             foreach my $userkey (keys(%{$useropt})) {
                   3942:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3943:                     my $newkey=$userkey;
1.548     raeburn  3944:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3945:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3946:                 }
                   3947:             }
1.473     amueller 3948:         }
                   3949:     }
1.552     raeburn  3950:     if (wantarray) {
                   3951:         return ($resourcedata,$classlist);
                   3952:     } else {
                   3953:         return $resourcedata;
                   3954:     }
1.207     www      3955: }
                   3956: 
                   3957: 
1.563     damieng  3958: # Stores parameter data, using form parameters directly.
                   3959: #
                   3960: # Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data).
1.588     raeburn  3961: # set_* (except settext, setipallow, setipdeny, setdeeplink) - set a parameter value
1.563     damieng  3962: # del_* - remove a parameter
                   3963: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3964: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3965: # key_* - date values
                   3966: # days_* - for date intervals
                   3967: # hours_* - for date intervals
                   3968: # minutes_* - for date intervals
                   3969: # seconds_* - for date intervals
                   3970: # done_* - for date intervals
                   3971: # typeof_* - parameter type
                   3972: # 
                   3973: # @param {Apache2::RequestRec} $r - the Apache request
                   3974: # @param {string} $crs - course number
                   3975: # @param {string} $dom - course domain
1.208     www      3976: sub storedata {
                   3977:     my ($r,$crs,$dom)=@_;
1.207     www      3978: # Set userlevel immediately
                   3979: # Do an intermediate store of course level
                   3980:     my $olddata=&readdata($crs,$dom);
1.124     www      3981:     my %newdata=();
                   3982:     undef %newdata;
                   3983:     my @deldata=();
1.576     raeburn  3984:     my @delrec=();
                   3985:     my @delnonrec=();
1.124     www      3986:     undef @deldata;
1.504     raeburn  3987:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3988:     my $now = time;
1.560     damieng  3989:     foreach my $key (keys(%env)) {
                   3990:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3991:             my $cmd=$1;
                   3992:             my $thiskey=$2;
1.576     raeburn  3993:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
1.588     raeburn  3994:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny' || $cmd eq 'setdeeplink');
1.576     raeburn  3995:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3996:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3997:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3998:                     $altkey = $thiskey;
                   3999:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4000:                     if ($env{'form.rec_'.$thiskey}) {
                   4001:                         $recursive = 1;
                   4002:                     }
                   4003:                 }
                   4004:             }
1.560     damieng  4005:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 4006:             if ($tuname) {
1.576     raeburn  4007:                 $tkey=$thiskey;
1.560     damieng  4008:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  4009:                 if ($altkey) {
                   4010:                     $tkeynonrec = $tkey; 
                   4011:                     $tkeyrec = $altkey;
                   4012:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   4013:                 }
1.560     damieng  4014:             }
                   4015:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  4016:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   4017:                 if ($cmd eq 'set') {
                   4018:                     $data=$env{$key};
                   4019:                     $valmatch = '';
                   4020:                     $valchk = $data;
                   4021:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4022:                     $text = &mt('Saved modified parameter for');
                   4023:                     if ($typeof eq 'string_questiontype') {
                   4024:                         $name = 'type';
1.588     raeburn  4025:                     } elsif (($typeof eq 'string_lenient') || ($typeof eq 'string_deeplink')) {
                   4026:                         ($name) = ($typeof =~ /^string_(lenient|deeplink)$/);
1.563     damieng  4027:                         my $stringmatch = &standard_string_matches($typeof);
                   4028:                         if (ref($stringmatch) eq 'ARRAY') {
                   4029:                             foreach my $item (@{$stringmatch}) {
                   4030:                                 if (ref($item) eq 'ARRAY') {
                   4031:                                     my ($regexpname,$pattern) = @{$item};
                   4032:                                     if ($pattern ne '') {
                   4033:                                         if ($data =~ /$pattern/) {
                   4034:                                             $valmatch = $regexpname;
                   4035:                                             $valchk = '';
                   4036:                                             last;
                   4037:                                         }
1.560     damieng  4038:                                     }
1.549     raeburn  4039:                                 }
                   4040:                             }
                   4041:                         }
1.563     damieng  4042:                     } elsif ($typeof eq 'string_discussvote') {
                   4043:                         $name = 'discussvote';
                   4044:                     } elsif ($typeof eq 'string_examcode') {
                   4045:                         $name = 'examcode';
                   4046:                         if (&Apache::lonnet::validCODE($data)) {
                   4047:                             $valchk = 'valid';
                   4048:                         }
                   4049:                     } elsif ($typeof eq 'string_yesno') {
                   4050:                         if ($thiskey =~ /\.retrypartial$/) {
                   4051:                             $name = 'retrypartial';
                   4052:                         }
1.549     raeburn  4053:                     }
1.563     damieng  4054:                 } elsif ($cmd eq 'datepointer') {
                   4055:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   4056:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4057:                     $text = &mt('Saved modified date for');
                   4058:                     if ($typeof eq 'date_start') {
                   4059:                         if ($thiskey =~ /\.printstartdate$/) {
                   4060:                             $name = 'printstartdate';
                   4061:                             if (($data) && ($data > $now)) {
                   4062:                                 $valchk = 'future';
                   4063:                             }
1.560     damieng  4064:                         }
1.563     damieng  4065:                     } elsif ($typeof eq 'date_end') {
                   4066:                         if ($thiskey =~ /\.printenddate$/) {
                   4067:                             $name = 'printenddate';
                   4068:                             if (($data) && ($data < $now)) {
                   4069:                                 $valchk = 'past';
                   4070:                             }
1.560     damieng  4071:                         }
1.504     raeburn  4072:                     }
1.563     damieng  4073:                 } elsif ($cmd eq 'dateinterval') {
                   4074:                     $data=&get_date_interval_from_form($thiskey);
                   4075:                     if ($thiskey =~ /\.interval$/) {
                   4076:                         $name = 'interval';
                   4077:                         my $intervaltype = &get_intervaltype($name);
                   4078:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   4079:                         if (ref($intervalmatch) eq 'ARRAY') {
                   4080:                             foreach my $item (@{$intervalmatch}) {
                   4081:                                 if (ref($item) eq 'ARRAY') {
                   4082:                                     my ($regexpname,$pattern) = @{$item};
                   4083:                                     if ($pattern ne '') {
                   4084:                                         if ($data =~ /$pattern/) {
                   4085:                                             $valmatch = $regexpname;
                   4086:                                             $valchk = '';
                   4087:                                             last;
                   4088:                                         }
1.560     damieng  4089:                                     }
1.554     raeburn  4090:                                 }
                   4091:                             }
                   4092:                         }
                   4093:                     }
1.563     damieng  4094:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4095:                     $text = &mt('Saved modified date for');
1.554     raeburn  4096:                 }
1.576     raeburn  4097:                 if ($recursive) {
1.563     damieng  4098:                     $namematch = 'maplevelrecurse';
1.560     damieng  4099:                 }
1.563     damieng  4100:                 if (($name ne '') || ($namematch ne '')) {
                   4101:                     my ($needsrelease,$needsnewer);
                   4102:                     if ($name ne '') {
                   4103:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  4104:                         if ($needsrelease) {
                   4105:                             unless ($got_chostname) {
1.563     damieng  4106:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  4107:                                 $got_chostname = 1;
                   4108:                             }
1.563     damieng  4109:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   4110:                                                                 $needsrelease,
                   4111:                                                                 $cmajor,$cminor);
                   4112:                         }
                   4113:                     }
                   4114:                     if ($namematch ne '') {
                   4115:                         if ($needsnewer) {
                   4116:                             undef($namematch);
1.560     damieng  4117:                         } else {
1.563     damieng  4118:                             my $currneeded;
                   4119:                             if ($needsrelease) {
                   4120:                                 $currneeded = $needsrelease;
                   4121:                             }
                   4122:                             $needsrelease =
                   4123:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   4124:                             if (($needsrelease) &&
                   4125:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   4126:                                 unless ($got_chostname) {
                   4127:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   4128:                                     $got_chostname = 1;
                   4129:                                 }
                   4130:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   4131:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   4132:                             } else {
                   4133:                                 undef($namematch);
                   4134:                             }
1.560     damieng  4135:                         }
1.557     raeburn  4136:                     }
1.563     damieng  4137:                     if ($needsnewer) {
                   4138:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   4139:                                                             $chostname,$cmajor,
                   4140:                                                             $cminor,$needsrelease));
                   4141:                         next;
                   4142:                     }
1.504     raeburn  4143:                 }
1.576     raeburn  4144:                 my ($reconlychg,$haschange,$storekey);
                   4145:                 if ($tuname) {
                   4146:                     my $ustorekey;
                   4147:                     if ($altkey) {
                   4148:                         if ($recursive) {
                   4149:                             if (exists($$olddata{$thiskey})) {
                   4150:                                 if ($$olddata{$thiskey} eq $data) {
                   4151:                                     $reconlychg = 1;
                   4152:                                 }
                   4153:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   4154:                             }
                   4155:                             if (exists($$olddata{$altkey})) {
                   4156:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4157:                                     $haschange = 1;
                   4158:                                 }
                   4159:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4160:                                 $haschange = 1;
                   4161:                             }
                   4162:                             $ustorekey = $tkeyrec;
                   4163:                         } else {
                   4164:                             if (exists($$olddata{$altkey})) {
                   4165:                                 if ($$olddata{$altkey} eq $data) {
                   4166:                                     $reconlychg = 1;
                   4167:                                 }
                   4168:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   4169:                             }
                   4170:                             if (exists($$olddata{$thiskey})) {
                   4171:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4172:                                     $haschange = 1;
                   4173:                                 }
                   4174:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4175:                                 $haschange = 1;
                   4176:                             }
                   4177:                             $ustorekey = $tkeynonrec;
                   4178:                         }
                   4179:                     } else {
                   4180:                         if (exists($$olddata{$tkey})) {
                   4181:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   4182:                                 $haschange = 1;
                   4183:                             }
                   4184:                             $ustorekey = $tkey;
                   4185:                         }
                   4186:                     }
                   4187:                     if ($haschange || $reconlychg)  {
                   4188:                         unless ($env{'form.del_'.$thiskey}) {
                   4189:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   4190:                                                                      $ustorekey.'.type' => $typeof},
                   4191:                                                                      $tudom,$tuname) eq 'ok') {
                   4192:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   4193:                                 $r->print('<br />'.$text.' '.
                   4194:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   4195:                             } else {
                   4196:                                 $r->print('<div class="LC_error">'.
                   4197:                                           &mt('Error saving parameters').'</div>');
                   4198:                             }
                   4199:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4200:                         }
                   4201:                     }
                   4202:                 } else {
                   4203:                     if ($altkey) {
                   4204:                         if ($recursive) {
                   4205:                             if (exists($$olddata{$thiskey})) {
                   4206:                                 if ($$olddata{$thiskey} eq $data) {
                   4207:                                     $reconlychg = 1;
                   4208:                                 }
                   4209:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   4210:                             }
                   4211:                             if (exists($$olddata{$altkey})) {
                   4212:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4213:                                     $haschange = 1;
                   4214:                                 }
                   4215:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4216:                                 $haschange = 1;
                   4217:                             }
                   4218:                             $storekey = $altkey;
1.563     damieng  4219:                         } else {
1.576     raeburn  4220:                             if (exists($$olddata{$altkey})) {
                   4221:                                 if ($$olddata{$altkey} eq $data) {
                   4222:                                     $reconlychg = 1;
                   4223:                                 }
                   4224:                                 push(@delrec,($altkey,$altkey.'.type'));
                   4225:                             } 
                   4226:                             if (exists($$olddata{$thiskey})) {
                   4227:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4228:                                     $haschange = 1;
                   4229:                                 }
                   4230:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4231:                                 $haschange = 1;
                   4232:                             }
                   4233:                             $storekey = $thiskey;
1.563     damieng  4234:                         }
1.560     damieng  4235:                     } else {
1.576     raeburn  4236:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4237:                             $haschange = 1;
                   4238:                             $storekey = $thiskey;
                   4239:                         }
                   4240:                     }
                   4241:                 }
                   4242:                 if ($reconlychg || $haschange) {
                   4243:                     unless ($env{'form.del_'.$thiskey}) {
                   4244:                         $newdata{$storekey}=$data;
                   4245:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  4246:                     }
                   4247:                 }
                   4248:             } elsif ($cmd eq 'del') {
                   4249:                 if ($tuname) {
1.576     raeburn  4250:                     my $error;
                   4251:                     if ($altkey) {  
                   4252:                         if (exists($$olddata{$altkey})) {
                   4253:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4254:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   4255:                                 if ($recursive) {
                   4256:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4257:                                 }
                   4258:                             } elsif ($recursive) {
                   4259:                                 $error = 1;
                   4260:                             }
                   4261:                         }
                   4262:                         if (exists($$olddata{$thiskey})) {
                   4263:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4264:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   4265:                                 unless ($recursive) {
                   4266:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4267:                                 }
                   4268:                             } elsif (!$recursive) {
                   4269:                                 $error = 1;
                   4270:                             }
                   4271:                         }
1.560     damieng  4272:                     } else {
1.576     raeburn  4273:                         if (exists($$olddata{$thiskey})) {
                   4274:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   4275:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   4276:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4277:                             } else {
                   4278:                                 $error = 1;
                   4279:                             }
                   4280:                         }
                   4281:                     }
                   4282:                     if ($error) { 
1.560     damieng  4283:                         $r->print('<div class="LC_error">'.
                   4284:                             &mt('Error deleting parameters').'</div>');
                   4285:                     }
                   4286:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4287:                 } else {
1.576     raeburn  4288:                     if ($altkey) {
                   4289:                         if (exists($$olddata{$altkey})) {
                   4290:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   4291:                                 push(@deldata,($altkey,$altkey.'.type'));
                   4292:                             }
                   4293:                         }
                   4294:                         if (exists($$olddata{$thiskey})) {
                   4295:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   4296:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   4297:                             }
                   4298:                         }
                   4299:                     } elsif (exists($$olddata{$thiskey})) {
                   4300:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   4301:                     }
1.560     damieng  4302:                 }
1.473     amueller 4303:             }
                   4304:         }
                   4305:     }
1.207     www      4306: # Store all course level
1.144     www      4307:     my $delentries=$#deldata+1;
1.576     raeburn  4308:     my @alldels;
                   4309:     if (@delrec) {
                   4310:         push(@alldels,@delrec);
                   4311:     }
                   4312:     if (@delnonrec) {
                   4313:         push(@alldels,@delnonrec);
                   4314:     }
                   4315:     if (@deldata) {
                   4316:         push(@alldels,@deldata);
                   4317:     }
1.548     raeburn  4318:     my @newdatakeys=keys(%newdata);
1.144     www      4319:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4320:     my ($delresult,$devalidate);
                   4321:     if (@alldels) {
                   4322:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4323:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4324:             &log_parmset(\%loghash,1);
1.576     raeburn  4325:             if ($delentries) {
                   4326:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4327:             }
                   4328:         } elsif ($delentries) {
1.560     damieng  4329:             $r->print('<div class="LC_error">'.
                   4330:                 &mt('Error deleting parameters').'</div>');
                   4331:         }
1.576     raeburn  4332:         $devalidate = 1; 
1.144     www      4333:     }
                   4334:     if ($putentries) {
1.560     damieng  4335:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4336:                     &log_parmset(\%newdata,0);
                   4337:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4338:         } else {
                   4339:             $r->print('<div class="LC_error">'.
                   4340:                 &mt('Error saving parameters').'</div>');
                   4341:         }
1.576     raeburn  4342:         $devalidate = 1; 
                   4343:     }
                   4344:     if ($devalidate) {
1.560     damieng  4345:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4346:     }
1.208     www      4347: }
1.207     www      4348: 
1.563     damieng  4349: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4350: #
                   4351: # @param {string} $key - the key
                   4352: # @returns {Array}
1.208     www      4353: sub extractuser {
                   4354:     my $key=shift;
1.350     albertel 4355:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4356: }
1.206     www      4357: 
1.563     damieng  4358: # Parses a parameter key and returns the components.
                   4359: #
                   4360: # @param {string} $key - 
                   4361: # @param {hash reference} $listdata - 
                   4362: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4363: sub parse_listdata_key {
                   4364:     my ($key,$listdata) = @_;
                   4365:     # split into student/section affected, and
                   4366:     # the realm (folder/resource part and parameter
1.446     bisitz   4367:     my ($student,$realm) =
1.473     amueller 4368:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4369:     # if course wide student would be undefined
                   4370:     if (!defined($student)) {
1.560     damieng  4371:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4372:     }
                   4373:     # strip off the .type if it's not the Question type parameter
                   4374:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4375:         $realm=~s/\.type//;
1.381     albertel 4376:     }
                   4377:     # split into resource+part and parameter name
1.388     albertel 4378:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4379:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4380:     return ($student,$res,$part,$parm);
                   4381: }
                   4382: 
1.563     damieng  4383: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4384: #
                   4385: # @param {Apache2::RequestRec} $r - the Apache request
                   4386: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4387: # @param {hash reference} $listdata - data created in secgroup_lister, course id.[section id].part.name -> 1 or course id.[section id].part.name.type -> parameter type
                   4388: # @param {string} $sortorder - realmstudent|studentrealm
                   4389: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4390: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4391: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4392: # @returns{integer} - number of $listdata parameters processed
1.208     www      4393: sub listdata {
1.568     raeburn  4394:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4395:     
1.207     www      4396: # Start list output
1.206     www      4397: 
1.122     www      4398:     my $oldsection='';
                   4399:     my $oldrealm='';
                   4400:     my $oldpart='';
1.123     www      4401:     my $pointer=0;
1.124     www      4402:     $tableopen=0;
1.145     www      4403:     my $foundkeys=0;
1.248     albertel 4404:     my %keyorder=&standardkeyorder();
1.594     raeburn  4405:     my $readonlyall = $readonly;
1.381     albertel 4406: 
1.552     raeburn  4407:     my ($secidx,%grouphash);
                   4408:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4409:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4410:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4411:             %grouphash = &Apache::longroup::coursegroups();
                   4412:         } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  4413:             map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  4414:         }
1.552     raeburn  4415:     }
                   4416: 
1.576     raeburn  4417:     foreach my $key (sort {
1.560     damieng  4418:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4419:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4420: 
1.560     damieng  4421:         # get the numerical order for the param
                   4422:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4423:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4424: 
1.560     damieng  4425:         my $result=0;
1.381     albertel 4426: 
1.560     damieng  4427:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4428:             if ($ares     ne $bres    ) {
1.560     damieng  4429:                 $result = ($ares     cmp $bres);
1.446     bisitz   4430:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4431:                 $result = ($astudent cmp $bstudent);
                   4432:             } elsif ($apart    ne $bpart   ) {
                   4433:                 $result = ($apart    cmp $bpart);
                   4434:             }
                   4435:         } else {
                   4436:             if      ($astudent ne $bstudent) {
                   4437:                 $result = ($astudent cmp $bstudent);
                   4438:             } elsif ($ares     ne $bres    ) {
                   4439:                 $result = ($ares     cmp $bres);
                   4440:             } elsif ($apart    ne $bpart   ) {
                   4441:                 $result = ($apart    cmp $bpart);
                   4442:             }
1.473     amueller 4443:         }
1.446     bisitz   4444: 
1.560     damieng  4445:         if (!$result) {
1.381     albertel 4446:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4447:                 $result = ($aparm <=> $bparm);
1.381     albertel 4448:             } elsif (defined($aparm)) {
1.560     damieng  4449:                 $result = -1;
1.381     albertel 4450:             } elsif (defined($bparm)) {
1.560     damieng  4451:                 $result = 1;
                   4452:             }
1.473     amueller 4453:         }
1.381     albertel 4454: 
1.560     damieng  4455:         $result;
                   4456:         
1.576     raeburn  4457:     } keys(%{$listdata})) { # foreach my $key
                   4458:         my $thiskey = $key;
1.560     damieng  4459:         if ($$listdata{$thiskey.'.type'}) {
                   4460:             my $thistype=$$listdata{$thiskey.'.type'};
                   4461:             if ($$resourcedata{$thiskey.'.type'}) {
                   4462:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4463:             }
                   4464:             my ($middle,$part,$name)=
1.572     damieng  4465:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4466:             my $section=&mt('All Students');
1.594     raeburn  4467:             $readonly = $readonlyall;
1.576     raeburn  4468:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4469:             if ($middle=~/^\[(.*)\]/) {
                   4470:                 my $issection=$1;
                   4471:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4472:                     my ($stuname,$studom) = ($1,$2);
                   4473:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4474:                         if (ref($classlist) eq 'HASH') {
                   4475:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4476:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4477:                             }
                   4478:                         }
                   4479:                     }
                   4480:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4481:                 } else {
                   4482:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4483:                         if (exists($grouphash{$issection})) {
                   4484:                             $section=&mt('Group').': '.$issection;
                   4485:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4486:                             $section = &mt('Section').': '.$issection;
                   4487:                         } else {
                   4488:                             next; 
1.552     raeburn  4489:                         }
1.560     damieng  4490:                     } else {
                   4491:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4492:                     }
                   4493:                 }
1.560     damieng  4494:                 $middle=~s/^\[(.*)\]//;
                   4495:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4496:                 $readonly = 1;
                   4497:             }
                   4498:             $middle=~s/\.+$//;
                   4499:             $middle=~s/^\.+//;
                   4500:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4501:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4502:             if ($caller eq 'overview') {
                   4503:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4504:                     $mapurl = $1;
                   4505:                     $maplevel = $2;
                   4506:                     $is_map = 1;
                   4507:                 }
                   4508:             } elsif ($caller eq 'newoverview') {
                   4509:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4510:                     $mapurl = $1;
                   4511:                     $maplevel = $2;
                   4512:                     $is_map = 1;
                   4513:                 }
                   4514:             }
                   4515:             if ($is_map) {
1.560     damieng  4516:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4517:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4518:                     if ($caller eq 'newoverview') {
                   4519:                         my $altkey = $thiskey;
                   4520:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4521:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4522:                             $is_recursive = 1;
                   4523:                             if ($$resourcedata{$altkey.'.type'}) {
                   4524:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4525:                             }
                   4526:                             $showval = $$resourcedata{$altkey};
                   4527:                         }
                   4528:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4529:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4530:                         $is_recursive = 1;
                   4531:                     }
1.560     damieng  4532:                 }
                   4533:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4534:             } elsif ($middle) {
                   4535:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4536:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4537:                     ': '.&Apache::lonnet::gettitle($middle).
                   4538:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4539:                     $id.')</span></span>';
                   4540:             }
                   4541:             if ($sortorder eq 'realmstudent') {
                   4542:                 if ($realm ne $oldrealm) {
                   4543:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4544:                     $oldrealm=$realm;
                   4545:                     $oldsection='';
                   4546:                 }
                   4547:                 if ($section ne $oldsection) {
                   4548:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4549:                     $oldsection=$section;
                   4550:                     $oldpart='';
                   4551:                 }
1.552     raeburn  4552:             } else {
1.560     damieng  4553:                 if ($section ne $oldsection) {
                   4554:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4555:                     $oldsection=$section;
                   4556:                     $oldrealm='';
                   4557:                 }
                   4558:                 if ($realm ne $oldrealm) {
                   4559:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4560:                     $oldrealm=$realm;
                   4561:                     $oldpart='';
1.552     raeburn  4562:                 }
                   4563:             }
1.560     damieng  4564:             if ($part ne $oldpart) {
                   4565:                 $r->print(&tableend().
                   4566:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4567:                 $oldpart=$part;
1.556     raeburn  4568:             }
1.560     damieng  4569:     #
                   4570:     # Ready to print
                   4571:     #
1.470     raeburn  4572:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4573:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4574:                 &Apache::loncommon::start_data_table_row().
                   4575:                 '<td><b>'.&mt($parmitem).
                   4576:                 '</b></td>');
                   4577:             unless ($readonly) {
                   4578:                 $r->print('<td><input type="checkbox" name="del_'.
                   4579:                         $thiskey.'" /></td>');
                   4580:             }
                   4581:             $r->print('<td>');
                   4582:             $foundkeys++;
                   4583:             if (&isdateparm($thistype)) {
                   4584:                 my $jskey='key_'.$pointer;
                   4585:                 my $state;
                   4586:                 $pointer++;
                   4587:                 if ($readonly) {
                   4588:                     $state = 'disabled';
                   4589:                 }
                   4590:                 $r->print(
                   4591:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4592:                                                         $jskey,
1.576     raeburn  4593:                                                         $showval,
1.560     damieng  4594:                                                         '',1,$state));
                   4595:                 unless  ($readonly) {
                   4596:                     $r->print(
                   4597:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4598:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4599:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4600:     &date_sanity_info($showval)
1.560     damieng  4601:                     );
                   4602:                 }
                   4603:             } elsif ($thistype eq 'date_interval') {
                   4604:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4605:                           $showval,$readonly));
1.560     damieng  4606:             } elsif ($thistype =~ m/^string/) {
                   4607:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4608:                           $showval,$name,$readonly));
1.560     damieng  4609:             } else {
1.576     raeburn  4610:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4611:             }
1.560     damieng  4612:             unless ($readonly) {
                   4613:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4614:                         $thistype.'" />');
1.552     raeburn  4615:             }
1.576     raeburn  4616:             $r->print('</td>');
                   4617:             if ($is_map) {
                   4618:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4619:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4620:                 } else {
                   4621:                     my ($disabled,$recon,$recoff);
                   4622:                     if ($readonly) {
                   4623:                         $disabled = ' disabled="disabled"';
                   4624:                     }
                   4625:                     if ($is_recursive) {
                   4626:                         $recon = ' checked="checked"';
                   4627:                     } else {
                   4628:                         $recoff = ' checked="checked"';
                   4629:                     }
                   4630:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4631:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4632:                 }
                   4633:             }
                   4634:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4635:         }
1.121     www      4636:     }
1.208     www      4637:     return $foundkeys;
                   4638: }
                   4639: 
1.563     damieng  4640: # Returns a string representing the interval, directly using form data matching the given key.
                   4641: # The returned string may also include information related to proctored exams.
                   4642: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4643: #
                   4644: # @param {string} $key - suffix for form fields related to the interval
                   4645: # @returns {string}
1.385     albertel 4646: sub get_date_interval_from_form {
                   4647:     my ($key) = @_;
                   4648:     my $seconds = 0;
                   4649:     foreach my $which (['days', 86400],
1.473     amueller 4650:                ['hours', 3600],
                   4651:                ['minutes', 60],
                   4652:                ['seconds',  1]) {
1.560     damieng  4653:         my ($name, $factor) = @{ $which };
                   4654:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4655:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4656:         }
1.473     amueller 4657:     }
1.560     damieng  4658:     if (($key =~ /\.interval$/) &&
                   4659:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4660:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4661:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4662:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4663:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4664:                 $seconds .= '_proctor';
                   4665:             }
                   4666:         } else {
                   4667:             $seconds .= $env{'form.done_'.$key}; 
                   4668:         }
                   4669:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4670:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4671:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4672:         }
1.554     raeburn  4673:     }
1.385     albertel 4674:     return $seconds;
                   4675: }
                   4676: 
                   4677: 
1.563     damieng  4678: # Returns HTML to enter a text value for a parameter.
                   4679: #
                   4680: # @param {string} $thiskey - parameter key
                   4681: # @param {string} $showval - the current value
                   4682: # @param {boolean} $readonly - true if the field should not be made editable
                   4683: # @returns {string}
1.383     albertel 4684: sub default_selector {
1.552     raeburn  4685:     my ($thiskey, $showval, $readonly) = @_;
                   4686:     my $disabled;
                   4687:     if ($readonly) {
                   4688:         $disabled = ' disabled="disabled"';
                   4689:     }
                   4690:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4691: }
                   4692: 
1.563     damieng  4693: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4694: #
                   4695: # @param {string} $thiskey - parameter key
                   4696: # @param {string} $showval - the current value
                   4697: # @param {boolean} $readonly - true if the fields should not be made editable
                   4698: # @returns {string}
1.549     raeburn  4699: sub string_ip_selector {
1.552     raeburn  4700:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4701:     my %access = (
                   4702:                    allow => [],
                   4703:                    deny  => [],
                   4704:                  );
                   4705:     if ($showval ne '') {
                   4706:         my @current;
                   4707:         if ($showval =~ /,/) {
                   4708:             @current = split(/,/,$showval);
                   4709:         } else {
                   4710:             @current = ($showval);
                   4711:         }
                   4712:         foreach my $item (@current) {
                   4713:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4714:                 push(@{$access{'deny'}},$1);
                   4715:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4716:                 push(@{$access{'allow'}},$item);
                   4717:             }
                   4718:         }
                   4719:     }
                   4720:     if (!@{$access{'allow'}}) {
                   4721:         @{$access{'allow'}} = ('');
                   4722:     }
                   4723:     if (!@{$access{'deny'}}) {
                   4724:         @{$access{'deny'}} = ('');
                   4725:     }
1.552     raeburn  4726:     my ($disabled,$addmore);
1.567     raeburn  4727:     if ($readonly) {
1.552     raeburn  4728:         $disabled=' disabled="disabled"';
                   4729:     } else {
                   4730:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4731:     }
1.549     raeburn  4732:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4733: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4734:     foreach my $acctype ('allow','deny') {
                   4735:         $output .= '
                   4736: <td valign="top">
                   4737: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4738:   <div class="LC_string_ipacc_inner">'."\n";
                   4739:         my $num = 0;
                   4740:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4741:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4742:             if ($num > 0) {
                   4743:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4744:             }
                   4745:             $output .= '</div>'."\n";
                   4746:             $num ++;
                   4747:         }
                   4748:         $output .= '
1.552     raeburn  4749:   </div>'.$addmore.'
1.549     raeburn  4750: </div>
                   4751: </td>';
                   4752:    }
                   4753:    $output .= '
                   4754: </tr>
                   4755: </table>'."\n";
                   4756:     return $output;
                   4757: }
                   4758: 
1.588     raeburn  4759: sub string_deeplink_selector {
                   4760:     my ($thiskey, $showval, $readonly) = @_;
                   4761:     my (@components,%values,@current,%titles,%options,%optiontext,%defaults,%posslti);
                   4762:     @components = ('listing','scope','urls');
                   4763:     %titles = &Apache::lonlocal::texthash (
                   4764:                   listing => 'In Contents and/or Gradebook',
                   4765:                   scope   => 'Access scope for link',
                   4766:                   urls    => 'Supported link types',
                   4767:               );
                   4768:     %options = (
                   4769:                    listing => ['full','absent','grades','details','datestatus'],
                   4770:                    scope   => ['res','map','rec'],
                   4771:                    urls    => ['any','only','key','lti'],
                   4772:                );
                   4773:     %optiontext = &Apache::lonlocal::texthash (
                   4774:                     full       => 'Listed (linked) in both',
                   4775:                     absent     => 'Not listed',
                   4776:                     grades     => 'Listed in grades only',
                   4777:                     details    => 'Listed (unlinked) in both',
                   4778:                     datestatus => 'Listed (unlinked) inc. status in both',
                   4779:                     res        => 'resource only',
                   4780:                     map        => 'enclosing map/folder',
                   4781:                     rec        => 'recursive map/folder',
                   4782:                     any        => 'regular + deep',
                   4783:                     only       => 'deep only',
                   4784:                     key        => 'deep with key',
                   4785:                     lti        => 'deep with LTI launch',
                   4786:                   );
                   4787:     if ($showval =~ /,/) {
                   4788:         @current = split(/,/,$showval);
                   4789:         ($values{'listing'}) = ($current[0] =~ /^(full|absent|grades|details|datestatus)$/);
                   4790:         ($values{'scope'}) = ($current[1] =~ /^(res|map|rec)$/);
                   4791:         ($values{'urls'}) = ($current[2] =~ /^(any|only|key:\w+|lti:\d+)$/);
                   4792:     } else {
                   4793:         $defaults{'listing'} = 'full';
                   4794:         $defaults{'scope'} = 'res';
                   4795:         $defaults{'urls'} = 'any';
                   4796:     }
                   4797:     my $disabled;
                   4798:     if ($readonly) {
                   4799:         $disabled=' disabled="disabled"';
                   4800:     }
                   4801:     my %lti = 
                   4802:         &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   4803:                                         'provider');
                   4804:     foreach my $item (keys(%lti)) {
                   4805:         if (ref($lti{$item}) eq 'HASH') {
                   4806:             unless ($lti{$item}{'requser'}) {
                   4807:                 $posslti{$item} = $lti{$item}{'consumer'};
                   4808:             }
                   4809:         }
                   4810:     }
                   4811:     my $output = '<input type="hidden" name="set_'.$thiskey.'" /><table><tr>';
                   4812:     foreach my $item ('listing','scope','urls') {
                   4813:         $output .= '<th>'.$titles{$item}.'</th>';
                   4814:     }
                   4815:     $output .= '</tr><tr>';
                   4816:     foreach my $item (@components) {
                   4817:         $output .= '<td>';
                   4818:         if ($item eq 'urls') {
                   4819:             my $selected = $values{$item};
                   4820:             foreach my $option (@{$options{$item}}) {
                   4821:                 if ($option eq 'lti') {
                   4822:                     next unless (keys(%posslti));
                   4823:                 }
                   4824:                 my $checked;
                   4825:                 if ($selected =~ /^\Q$option\E/) {
                   4826:                     $checked = ' checked="checked"';
                   4827:                 }
                   4828:                 my $onclick;
                   4829:                 unless ($readonly) {
                   4830:                     my $esc_key = &js_escape($thiskey);
                   4831:                     $onclick = ' onclick="toggleDeepLink(this.form,'."'$item','$esc_key'".');"';
                   4832:                 }
                   4833:                 $output .= '<span class="LC_nobreak"><label>'.
                   4834:                            '<input type="radio" name="deeplink_'.$item.'_'.$thiskey.'" value="'.$option.'"'.$onclick.$disabled.$checked.' />'."\n".
                   4835:                            $optiontext{$option}.'</label>';
                   4836:                 if ($option eq 'key') {
                   4837:                     my $visibility="hidden";
                   4838:                     my $currkey;
                   4839:                     if ($checked) {
                   4840:                         $visibility = "text";
                   4841:                         $currkey = (split(/\:/,$values{$item}))[1];
                   4842:                     }
                   4843:                     $output .= '&nbsp;'.
                   4844:                         '<input type="'.$visibility.'" name="deeplink_'.$option.'_'.$thiskey.'" id="deeplink_'.$option.'_'.$item.'_'.$thiskey.'" value="'.$currkey.'" size="6"'.$disabled.' />';
                   4845:                 } elsif ($option eq 'lti') {
                   4846:                     my $display="none";
                   4847:                     my ($currlti,$blankcheck);
                   4848:                     if ($checked) {
                   4849:                         $display = 'inline-block';
                   4850:                         $currlti = (split(/\:/,$values{$item}))[1];
                   4851:                     } else {
                   4852:                         $blankcheck = ' selected="selected"';
                   4853:                     }
                   4854:                     $output .= '<div id="deeplinkdiv_'.$option.'_'.$item.'_'.$thiskey.'"'.
                   4855:                                ' style="display: '.$display.'">&nbsp;<select name="'.
                   4856:                                'deeplink_'.$option.'_'.$thiskey.'"'.$disabled.'>'.
                   4857:                                '<option value=""'.$blankcheck.'>'.&mt('Select Provider').'</option>'."\n";
                   4858:                     foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   4859:                         my $selected;
                   4860:                         if ($lti == $currlti) {
                   4861:                             $selected = ' selected="selected"';
                   4862:                         }
                   4863:                         $output .= '<option value="'.$lti.'"'.$selected.'>'.$posslti{$lti}.'</option>';
                   4864:                     }
                   4865:                     $output .= '</select></div>';
                   4866:                 }
                   4867:                 $output .= '</span> ';
                   4868:             }
                   4869:         } else {
                   4870:             my $selected = $values{$item};
                   4871:             my $defsel;
                   4872:             if ($selected eq '') {
                   4873:                 $defsel = ' selected="selected"';
                   4874:             }
                   4875:             $output .= '<select name="deeplink_'.$item.'_'.$thiskey.'"'.$disabled.'>'."\n".
                   4876:                        '<option value=""'.$defsel.'>'.&mt('Please select').'</option>'."\n";
                   4877:             foreach my $option (@{$options{$item}}) {
                   4878:                 $output .= '<option value="'.$option.'"';
                   4879:                 if ($option eq $selected) {
                   4880:                     $output .= ' selected="selected"';
                   4881:                 }
                   4882:                 $output .= '>'.$optiontext{$option}.'</option>';
                   4883:             }
                   4884:             $output .= '</select>';
                   4885:         }
                   4886:         $output .= '</td>';
                   4887:     }
                   4888:     $output .= '</tr></table>'."\n";
                   4889:     return $output;
                   4890: }
                   4891: 
1.560     damieng  4892: 
                   4893: { # block using some constants related to parameter types (overview mode)
                   4894: 
1.446     bisitz   4895: my %strings =
1.383     albertel 4896:     (
                   4897:      'string_yesno'
                   4898:              => [[ 'yes', 'Yes' ],
1.560     damieng  4899:                  [ 'no', 'No' ]],
1.383     albertel 4900:      'string_problemstatus'
                   4901:              => [[ 'yes', 'Yes' ],
1.473     amueller 4902:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4903:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4904:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4905:      'string_questiontype'
                   4906:              => [[ 'problem', 'Standard Problem'],
                   4907:                  [ 'survey', 'Survey'],
                   4908:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4909:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4910:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4911:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4912:                  [ 'practice', 'Practice'],
                   4913:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4914:      'string_lenient'
                   4915:              => [['yes', 'Yes' ],
                   4916:                  [ 'no', 'No' ],
1.549     raeburn  4917:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4918:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4919:      'string_discussvote'
                   4920:              => [['yes','Yes'],
                   4921:                  ['notended','Yes, unless discussion ended'],
                   4922:                  ['no','No']],
1.549     raeburn  4923:      'string_ip'
                   4924:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
1.587     raeburn  4925:                  ['_denyfrom_','Hostname(s) or IP(s) from which access is disallowed']], 
                   4926:      'string_deeplink'
1.588     raeburn  4927:              => [['on','Set choices for link protection, resource listing, and access scope']],
1.587     raeburn  4928:     );
                   4929:    
1.383     albertel 4930: 
1.549     raeburn  4931: my %stringmatches = (
                   4932:          'string_lenient'
                   4933:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4934:          'string_ip'
                   4935:               => [['_allowfrom_','[^\!]+'],
                   4936:                   ['_denyfrom_','\!']],
1.588     raeburn  4937:          'string_deeplink'
                   4938:               => [['on','^(full|absent|grades|details|datestatus)\,(res|map|rec)\,(any|only|key\:\w+|lti\:\d+)$']],
1.549     raeburn  4939:     );
                   4940: 
                   4941: my %stringtypes = (
                   4942:                     type         => 'string_questiontype',
                   4943:                     lenient      => 'string_lenient',
                   4944:                     retrypartial => 'string_yesno',
                   4945:                     discussvote  => 'string_discussvote',
                   4946:                     examcode     => 'string_examcode',
                   4947:                     acc          => 'string_ip',
1.587     raeburn  4948:                     deeplink     => 'string_deeplink',
1.549     raeburn  4949:                   );
                   4950: 
1.563     damieng  4951: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4952: # Used by courseprefs.
                   4953: #
                   4954: # @param {string} $string_type - a parameter type for strings
                   4955: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4956: sub standard_string_options {
                   4957:     my ($string_type) = @_;
                   4958:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4959:         return $strings{$string_type};
                   4960:     }
                   4961:     return;
                   4962: }
1.383     albertel 4963: 
1.563     damieng  4964: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4965: #
                   4966: # @param {string} $string_type - a parameter type for strings
                   4967: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4968: sub standard_string_matches {
                   4969:     my ($string_type) = @_;
                   4970:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4971:         return $stringmatches{$string_type};
                   4972:     }
                   4973:     return;
                   4974: }
                   4975: 
1.563     damieng  4976: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4977: #
                   4978: # @param {string} $name - parameter name
                   4979: # @returns {string}
1.549     raeburn  4980: sub get_stringtype {
                   4981:     my ($name) = @_;
                   4982:     if (exists($stringtypes{$name})) {
                   4983:         return $stringtypes{$name};
                   4984:     }
                   4985:     return;
                   4986: }
                   4987: 
1.563     damieng  4988: # Returns HTML to edit a string parameter.
                   4989: #
                   4990: # @param {string} $thistype - parameter type
                   4991: # @param {string} $thiskey - parameter key
                   4992: # @param {string} $showval - parameter current value
                   4993: # @param {string} $name - parameter name
                   4994: # @param {boolean} $readonly - true if the values should not be made editable
                   4995: # @returns {string}
1.383     albertel 4996: sub string_selector {
1.552     raeburn  4997:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4998: 
1.383     albertel 4999:     if (!exists($strings{$thistype})) {
1.552     raeburn  5000:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 5001:     }
                   5002: 
1.504     raeburn  5003:     my %skiptype;
1.514     raeburn  5004:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  5005:             ($thistype eq 'string_lenient') ||
                   5006:             ($thistype eq 'string_discussvote') ||
                   5007:             ($thistype eq 'string_ip') ||
1.588     raeburn  5008:             ($thistype eq 'string_deeplink') ||
1.560     damieng  5009:             ($name eq 'retrypartial')) {
1.504     raeburn  5010:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   5011:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   5012:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  5013:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  5014:             my $parmmatch;
                   5015:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   5016:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   5017:                     if (ref($item) eq 'ARRAY') {
                   5018:                         if ($parmval eq $item->[0]) {
                   5019:                             $parmmatch = $parmval;
                   5020:                             $parmval = '';
                   5021:                             last;
                   5022:                         }
                   5023:                     }
                   5024:                 }
                   5025:             }
                   5026:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  5027:             if ($needsrelease) {
                   5028:                 unless ($got_chostname) {
1.514     raeburn  5029:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  5030:                     $got_chostname = 1;
                   5031:                 }
1.557     raeburn  5032:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  5033:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  5034:                 if ($needsnewer) {
1.549     raeburn  5035:                     if ($parmmatch ne '') {
                   5036:                         $skiptype{$parmmatch} = 1;
                   5037:                     } elsif ($parmval ne '') {
                   5038:                         $skiptype{$parmval} = 1;
                   5039:                     }
1.504     raeburn  5040:                 }
                   5041:             }
                   5042:         }
                   5043:     }
1.549     raeburn  5044: 
                   5045:     if ($thistype eq 'string_ip') {
1.552     raeburn  5046:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.588     raeburn  5047:     } elsif ($thistype eq 'string_deeplink') {
                   5048:         return &string_deeplink_selector($thiskey,$showval,$readonly);
1.549     raeburn  5049:     }
1.504     raeburn  5050: 
1.552     raeburn  5051:     my ($result,$disabled);
                   5052: 
                   5053:     if ($readonly) {
                   5054:         $disabled = ' disabled="disabled"';
                   5055:     }
1.504     raeburn  5056:     my $numinrow = 3;
                   5057:     if ($thistype eq 'string_problemstatus') {
                   5058:         $numinrow = 2;
                   5059:     } elsif ($thistype eq 'string_questiontype') {
                   5060:         if (keys(%skiptype) > 0) {
                   5061:              $numinrow = 4;
                   5062:         }
                   5063:     }
                   5064:     my $rem;
                   5065:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   5066:         my $i=0;
                   5067:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   5068:             next unless (ref($possibilities) eq 'ARRAY');
                   5069:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  5070:             next if ($skiptype{$name});
1.504     raeburn  5071:             $rem = $i%($numinrow);
                   5072:             if ($rem == 0) {
                   5073:                 if ($i > 0) {
                   5074:                     $result .= '</tr>';
                   5075:                 }
                   5076:                 $result .= '<tr>';
                   5077:             }
1.549     raeburn  5078:             my $colspan;
                   5079:             if ($i == @{ $strings{$thistype} }-1) {
                   5080:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   5081:                 if ($rem) {
                   5082:                     my $colsleft = $numinrow - $rem;
                   5083:                     if ($colsleft) {
                   5084:                         $colspan = $colsleft+1;
                   5085:                         $colspan = ' colspan="'.$colspan.'"';
                   5086:                     }
                   5087:                 }
                   5088:             }
                   5089:             my ($add,$onchange,$css_class);
                   5090:             if ($thistype eq 'string_lenient') {
                   5091:                 if ($name eq 'weighted') {
                   5092:                     my $display;
                   5093:                     my %relatives = &Apache::lonlocal::texthash(
                   5094:                                         corrchkd     => 'Correct (checked)',
                   5095:                                         corrunchkd   => 'Correct (unchecked)',
                   5096:                                         incorrchkd   => 'Incorrect (checked)',
                   5097:                                         incorrunchkd => 'Incorrect (unchecked)',
                   5098:                     );
                   5099:                     my %textval = (
                   5100:                                     corrchkd     => '1.0',
                   5101:                                     corrunchkd   => '1.0',
                   5102:                                     incorrchkd   => '0.0',
                   5103:                                     incorrunchkd => '0.0',
                   5104:                     );
                   5105:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   5106:                         $textval{'corrchkd'} = $1;
                   5107:                         $textval{'corrunchkd'} = $2;
                   5108:                         $textval{'incorrchkd'} = $3;
                   5109:                         $textval{'incorrunchkd'} = $4;
                   5110:                         $display = 'inline';
                   5111:                         $showval = $name;
                   5112:                     } else {
                   5113:                         $display = 'none';
                   5114:                     }
                   5115:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   5116:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   5117:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   5118:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   5119:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  5120:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  5121:                                 '</td></tr>';
                   5122:                     }
                   5123:                     $add .= '</table></div>'."\n";
                   5124:                 }
                   5125:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   5126:                 $css_class = ' class="LC_lenient_radio"';
                   5127:             }
                   5128:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  5129:                        '<span class="LC_nobreak"><label>'.
                   5130:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  5131:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  5132:             if ($showval eq $name) {
                   5133:                 $result .= ' checked="checked"';
                   5134:             }
1.549     raeburn  5135:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  5136:             $i++;
                   5137:         }
                   5138:         $result .= '</tr>';
1.473     amueller 5139:     }
1.504     raeburn  5140:     if ($result) {
                   5141:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 5142:     }
                   5143:     return $result;
                   5144: }
                   5145: 
1.554     raeburn  5146: my %intervals =
                   5147:     (
                   5148:      'date_interval'
                   5149:              => [[ 'done', 'Yes' ],
1.558     raeburn  5150:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  5151:                  [ '', 'No' ]],
                   5152:     );
                   5153: 
                   5154: my %intervalmatches = (
                   5155:          'date_interval'
1.559     raeburn  5156:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   5157:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  5158:     );
                   5159: 
                   5160: my %intervaltypes = (
                   5161:                       interval => 'date_interval',
                   5162:     );
                   5163: 
1.563     damieng  5164: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   5165: #
                   5166: # @param {string} $interval_type - a parameter type for intervals
                   5167: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  5168: sub standard_interval_matches {
                   5169:     my ($interval_type) = @_;
                   5170:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   5171:         return $intervalmatches{$interval_type};
                   5172:     }
                   5173:     return;
                   5174: }
                   5175: 
1.563     damieng  5176: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   5177: #
                   5178: # @param {string} $name - parameter name
                   5179: # @returns {string}
1.554     raeburn  5180: sub get_intervaltype {
                   5181:     my ($name) = @_;
                   5182:     if (exists($intervaltypes{$name})) {
                   5183:         return $intervaltypes{$name};
                   5184:     }
                   5185:     return;
                   5186: }
                   5187: 
1.563     damieng  5188: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   5189: # Used by courseprefs.
                   5190: #
                   5191: # @param {string} $interval_type - a parameter type for intervals
                   5192: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  5193: sub standard_interval_options {
                   5194:     my ($interval_type) = @_;
                   5195:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   5196:         return $intervals{$interval_type};
                   5197:     }
                   5198:     return;
                   5199: }
                   5200: 
1.563     damieng  5201: # Returns HTML to edit a date interval parameter.
                   5202: #
                   5203: # @param {string} $thiskey - parameter key
                   5204: # @param {string} $name - parameter name
                   5205: # @param {string} $showval - parameter current value
                   5206: # @param {boolean} $readonly - true if the values should not be made editable
                   5207: # @returns {string}
1.554     raeburn  5208: sub date_interval_selector {
                   5209:     my ($thiskey, $name, $showval, $readonly) = @_;
                   5210:     my ($result,%skipval);
                   5211:     if ($name eq 'interval') {
                   5212:         my $intervaltype = &get_intervaltype($name);
                   5213:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   5214:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   5215:             next unless (ref($possibilities) eq 'ARRAY');
                   5216:             my ($parmval, $description) = @{ $possibilities };
                   5217:             my $parmmatch;
                   5218:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   5219:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   5220:                     if (ref($item) eq 'ARRAY') {
                   5221:                         if ($parmval eq $item->[0]) {
                   5222:                             $parmmatch = $parmval;
                   5223:                             $parmval = '';
                   5224:                             last;
                   5225:                         }
                   5226:                     }
                   5227:                 }
                   5228:             }
                   5229:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   5230:             if ($needsrelease) {
                   5231:                 unless ($got_chostname) {
                   5232:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   5233:                     $got_chostname = 1;
                   5234:                 }
1.557     raeburn  5235:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  5236:                                                        $needsrelease,$cmajor,$cminor);
                   5237:                 if ($needsnewer) {
                   5238:                     if ($parmmatch ne '') {
                   5239:                         $skipval{$parmmatch} = 1;
                   5240:                     } elsif ($parmval ne '') {
                   5241:                         $skipval{$parmval} = 1;
                   5242:                     }
                   5243:                 }
                   5244:             }
                   5245:         }
                   5246:     }
                   5247: 
                   5248:     my $currval = $showval;
                   5249:     foreach my $which (['days', 86400, 31],
                   5250:                ['hours', 3600, 23],
                   5251:                ['minutes', 60, 59],
                   5252:                ['seconds',  1, 59]) {
1.560     damieng  5253:         my ($name, $factor, $max) = @{ $which };
                   5254:         my $amount = int($showval/$factor);
                   5255:         $showval  %= $factor;
                   5256:         my %select = ((map {$_ => $_} (0..$max)),
                   5257:                 'select_form_order' => [0..$max]);
                   5258:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   5259:                             \%select,'',$readonly);
                   5260:         $result .= ' '.&mt($name);
1.554     raeburn  5261:     }
                   5262:     if ($name eq 'interval') {
                   5263:         unless ($skipval{'done'}) {
                   5264:             my $checkedon = '';
1.558     raeburn  5265:             my $checkedproc = '';
                   5266:             my $currproctorkey = '';
                   5267:             my $currprocdisplay = 'hidden';
1.559     raeburn  5268:             my $currdonetext = &mt('Done');
1.554     raeburn  5269:             my $checkedoff = ' checked="checked"';
1.559     raeburn  5270:             if ($currval =~ /^(?:\d+)_done$/) {
                   5271:                 $checkedon = ' checked="checked"';
                   5272:                 $checkedoff = '';
                   5273:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   5274:                 $currdonetext = $1;
1.554     raeburn  5275:                 $checkedon = ' checked="checked"';
                   5276:                 $checkedoff = '';
1.558     raeburn  5277:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   5278:                 $currproctorkey = $1;
                   5279:                 $checkedproc = ' checked="checked"';
                   5280:                 $checkedoff = '';
                   5281:                 $currprocdisplay = 'text';
1.559     raeburn  5282:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   5283:                 $currdonetext = $1;
                   5284:                 $currproctorkey = $2;
                   5285:                 $checkedproc = ' checked="checked"';
                   5286:                 $checkedoff = '';
                   5287:                 $currprocdisplay = 'text';
1.554     raeburn  5288:             }
1.558     raeburn  5289:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  5290:             my $disabled;
                   5291:             if ($readonly) {
                   5292:                 $disabled = ' disabled="disabled"';
                   5293:             }
1.558     raeburn  5294:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  5295:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  5296:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  5297:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  5298:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  5299:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  5300:                        &mt('Yes, with proctor key').'</label>'.
                   5301:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  5302:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  5303:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  5304:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  5305:         }
                   5306:     }
                   5307:     unless ($readonly) {
                   5308:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   5309:     }
                   5310:     return $result;
                   5311: }
                   5312: 
1.563     damieng  5313: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   5314: #
                   5315: # @param {string} $name - parameter name
                   5316: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5317: # @param {string} $value - parameter value
                   5318: # @param {string} $chostname - course server name
                   5319: # @param {integer} $cmajor - major version number
                   5320: # @param {integer} $cminor - minor version number
                   5321: # @param {string} $needsrelease - release version needed (major.minor)
                   5322: # @returns {string}
1.549     raeburn  5323: sub oldversion_warning {
1.557     raeburn  5324:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   5325:     my $standard_name = &standard_parameter_names($name);
                   5326:     if ($namematch) {
                   5327:         my $level = &standard_parameter_levels($namematch);
                   5328:         my $msg = '';
                   5329:         if ($level) {
                   5330:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   5331:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   5332:         } else {
                   5333:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   5334:                       $standard_name,'<b>','</b>');
                   5335:         }
                   5336:         return '<p class="LC_warning">'.$msg.'<br />'.
                   5337:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5338:                    $cmajor.'.'.$cminor,$chostname,
                   5339:                    $needsrelease).
                   5340:                    '</p>';
                   5341:     }
1.549     raeburn  5342:     my $desc;
                   5343:     my $stringtype = &get_stringtype($name);
                   5344:     if ($stringtype ne '') {
                   5345:         if ($name eq 'examcode') {
                   5346:             $desc = $value;
                   5347:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   5348:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   5349:                 next unless (ref($possibilities) eq 'ARRAY');
                   5350:                 my ($parmval, $description) = @{ $possibilities };
                   5351:                 my $parmmatch;
                   5352:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   5353:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   5354:                         if (ref($item) eq 'ARRAY') {
                   5355:                             my ($regexpname,$pattern) = @{$item};
                   5356:                             if ($parmval eq $regexpname) {
                   5357:                                 if ($value =~ /$pattern/) {
                   5358:                                     $desc = $description; 
                   5359:                                     $parmmatch = 1;
                   5360:                                     last;
                   5361:                                 }
                   5362:                             }
                   5363:                         }
                   5364:                     }
                   5365:                     last if ($parmmatch);
                   5366:                 } elsif ($parmval eq $value) {
                   5367:                     $desc = $description;
                   5368:                     last;
                   5369:                 }
                   5370:             }
                   5371:         }
                   5372:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   5373:         my $now = time;
                   5374:         if ($value =~ /^\d+$/) {
                   5375:             if ($name eq 'printstartdate') {
                   5376:                 if ($value > $now) {
                   5377:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5378:                 }
                   5379:             } elsif ($name eq 'printenddate') {
                   5380:                 if ($value < $now) {
                   5381:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5382:                 }
                   5383:             }
                   5384:         }
                   5385:     }
                   5386:     return '<p class="LC_warning">'.
1.557     raeburn  5387:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   5388:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   5389:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5390:        $cmajor.'.'.$cminor,$chostname,
                   5391:        $needsrelease).
                   5392:        '</p>';
1.549     raeburn  5393: }
                   5394: 
1.560     damieng  5395: } # end of block using some constants related to parameter types
                   5396: 
1.549     raeburn  5397: 
1.563     damieng  5398: 
                   5399: # Shifts all start and end dates in the current course by $shift.
1.389     www      5400: #
1.563     damieng  5401: # @param {integer} $shift - time to shift, in seconds
                   5402: # @returns {string} - error name or 'ok'
1.389     www      5403: sub dateshift {
1.594     raeburn  5404:     my ($shift,$numchanges)=@_;
1.389     www      5405:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5406:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.594     raeburn  5407:     my $sec = $env{'request.course.sec'};
1.595   ! raeburn  5408:     my $secgrpregex;
        !          5409:     if ($sec ne '') {
        !          5410:         my @groups;
        !          5411:         if ($env{'request.course.groups'} ne '') {
        !          5412:             @groups = split(/:/,$env{'request.course.groups'});
        !          5413:         }
        !          5414:         if (@groups) {
        !          5415:             $secgrpregex = '(?:'.join('|',($sec,@groups)).')';
        !          5416:         } else {
        !          5417:             $secgrpregex = $sec;
        !          5418:         }
        !          5419:     }
1.389     www      5420:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   5421: # ugly retro fix for broken version of types
1.548     raeburn  5422:     foreach my $key (keys(%data)) {
1.389     www      5423:         if ($key=~/\wtype$/) {
                   5424:             my $newkey=$key;
                   5425:             $newkey=~s/type$/\.type/;
                   5426:             $data{$newkey}=$data{$key};
                   5427:             delete $data{$key};
                   5428:         }
                   5429:     }
1.391     www      5430:     my %storecontent=();
1.389     www      5431: # go through all parameters and look for dates
1.548     raeburn  5432:     foreach my $key (keys(%data)) {
1.389     www      5433:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
1.594     raeburn  5434:           if ($sec ne '') {
1.595   ! raeburn  5435:               next unless ($key =~ /^$env{'request.course.id'}\.\[$secgrpregex\]\./);
1.594     raeburn  5436:           }
1.389     www      5437:           my $newdate=$data{$key}+$shift;
1.594     raeburn  5438:           $$numchanges ++;
1.391     www      5439:           $storecontent{$key}=$newdate;
1.389     www      5440:        }
                   5441:     }
1.391     www      5442:     my $reply=&Apache::lonnet::cput
                   5443:                 ('resourcedata',\%storecontent,$dom,$crs);
                   5444:     if ($reply eq 'ok') {
                   5445:        &log_parmset(\%storecontent);
                   5446:     }
                   5447:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   5448:     return $reply;
1.389     www      5449: }
                   5450: 
1.563     damieng  5451: # Overview mode UI to edit course parameters.
                   5452: #
                   5453: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5454: sub newoverview {
1.568     raeburn  5455:     my ($r,$parm_permission) = @_;
1.280     albertel 5456: 
1.208     www      5457:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5458:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5459:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5460:     my $readonly = 1;
                   5461:     if ($parm_permission->{'edit'}) {
                   5462:         undef($readonly);
                   5463:     }
1.414     droeschl 5464:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5465:         text=>"Overview Mode"});
1.523     raeburn  5466: 
                   5467:     my %loaditems = (
1.549     raeburn  5468:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5469:                     );
                   5470:     my $js = '
                   5471: <script type="text/javascript">
                   5472: // <![CDATA[
                   5473: '.
                   5474:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5475:             &showhide_js()."\n".
1.549     raeburn  5476:             &toggleparmtextbox_js()."\n".
                   5477:             &validateparms_js()."\n".
                   5478:             &ipacc_boxes_js()."\n".
1.558     raeburn  5479:             &done_proctor_js()."\n".
1.588     raeburn  5480:             &deeplink_js()."\n".
1.523     raeburn  5481: '// ]]>
                   5482: </script>
                   5483: ';
1.549     raeburn  5484: 
1.523     raeburn  5485:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5486:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5487:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5488:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5489:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5490:     $r->print(<<ENDOVER);
1.549     raeburn  5491: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5492: ENDOVER
1.211     www      5493:     my @ids=();
                   5494:     my %typep=();
                   5495:     my %keyp=();
                   5496:     my %allparms=();
                   5497:     my %allparts=();
                   5498:     my %allmaps=();
                   5499:     my %mapp=();
                   5500:     my %symbp=();
                   5501:     my %maptitles=();
                   5502:     my %uris=();
                   5503:     my %keyorder=&standardkeyorder();
                   5504:     my %defkeytype=();
                   5505: 
                   5506:     my %alllevs=();
                   5507:     $alllevs{'Resource Level'}='full';
1.215     www      5508:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5509:     $alllevs{'Course Level'}='general';
                   5510: 
                   5511:     my $csec=$env{'form.csec'};
1.269     raeburn  5512:     my $cgroup=$env{'form.cgroup'};
1.211     www      5513: 
                   5514:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5515:     my $pschp=$env{'form.pschp'};
1.506     www      5516: 
1.211     www      5517:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5518:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5519: 
1.446     bisitz   5520:     my @selected_sections =
1.473     amueller 5521:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5522:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5523:     foreach my $sec (@selected_sections) {
                   5524:         if ($sec eq 'all') {
1.211     www      5525:             @selected_sections = ('all');
                   5526:         }
                   5527:     }
1.552     raeburn  5528:     if ($env{'request.course.sec'} ne '') {
                   5529:         @selected_sections = ($env{'request.course.sec'});
                   5530:     }
1.269     raeburn  5531:     my @selected_groups =
                   5532:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5533: 
                   5534:     my $pssymb='';
                   5535:     my $parmlev='';
1.446     bisitz   5536: 
1.211     www      5537:     unless ($env{'form.parmlev'}) {
                   5538:         $parmlev = 'map';
                   5539:     } else {
                   5540:         $parmlev = $env{'form.parmlev'};
                   5541:     }
                   5542: 
1.446     bisitz   5543:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5544:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5545:                 \%keyorder,\%defkeytype);
1.211     www      5546: 
1.374     albertel 5547:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5548:         @psprt = keys(%allparts);
1.374     albertel 5549:     }
1.211     www      5550: # Menu to select levels, etc
                   5551: 
1.456     bisitz   5552:     $r->print('<div class="LC_Box">');
1.445     neumanie 5553:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5554:     $r->print('<div>');
1.523     raeburn  5555:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5556:     &levelmenu($r,\%alllevs,$parmlev);
                   5557:     if ($parmlev ne 'general') {
1.447     bisitz   5558:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5559:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5560:     }
1.447     bisitz   5561:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5562:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5563:     $r->print('</div></div>');
1.446     bisitz   5564: 
1.456     bisitz   5565:     $r->print('<div class="LC_Box">');
1.452     bisitz   5566:     $r->print('<div>');
1.581     raeburn  5567:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5568:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5569:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5570:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5571:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5572:     $r->print('<table>'.
1.553     raeburn  5573:               '<tr><th>'.&mt('Parts').'</th>');
                   5574:     if ($sectionselector) {
                   5575:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5576:     }
                   5577:     if ($groupselector) {
                   5578:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5579:     }
                   5580:     $r->print('</tr><tr><td>');
1.211     www      5581:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5582:     $r->print('</td>');
                   5583:     if ($sectionselector) { 
                   5584:         $r->print('<td>'.$sectionselector.'</td>');
                   5585:     }
                   5586:     if ($groupselector) {
                   5587:         $r->print('<td>'.$groupselector.'</td>');
                   5588:     }
                   5589:     $r->print('</tr></table>');
1.447     bisitz   5590:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5591:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5592:     $r->print('</div></div>');
                   5593: 
1.456     bisitz   5594:     $r->print('<div class="LC_Box">');
1.452     bisitz   5595:     $r->print('<div>');
1.214     www      5596:     my $sortorder=$env{'form.sortorder'};
                   5597:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5598:     &sortmenu($r,$sortorder);
1.445     neumanie 5599:     $r->print('</div></div>');
1.446     bisitz   5600: 
1.214     www      5601:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5602: 
1.211     www      5603: # Build the list data hash from the specified parms
                   5604: 
                   5605:     my $listdata;
                   5606:     %{$listdata}=();
                   5607: 
                   5608:     foreach my $cat (@pscat) {
1.269     raeburn  5609:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5610:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5611:     }
                   5612: 
1.212     www      5613:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5614: 
1.481     amueller 5615:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5616: 
                   5617: # Read modified data
                   5618: 
1.481     amueller 5619:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5620: 
                   5621: # List data
                   5622: 
1.568     raeburn  5623:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5624:     }
                   5625:     $r->print(&tableend());
                   5626:     unless ($readonly) {
                   5627:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5628:     }
1.568     raeburn  5629:     $r->print('</form>');
1.507     www      5630:     &endSettingsScreen($r);
                   5631:     $r->print(&Apache::loncommon::end_page());
1.208     www      5632: }
                   5633: 
1.563     damieng  5634: # Fills $listdata with parameter information.
                   5635: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5636: # The non-type value is always 1.
                   5637: #
                   5638: # @param {string} $cat - parameter name
1.566     damieng  5639: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5640: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5641: # @param {hash reference} $listdata - the parameter data that will be modified
                   5642: # @param {array reference} $psprt - selected parts
                   5643: # @param {array reference} $selections - selected sections
                   5644: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5645: # @param {hash reference} $allmaps - hash map pc -> map src
                   5646: # @param {array reference} $ids - resource and map ids
                   5647: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5648: sub secgroup_lister {
                   5649:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5650:     foreach my $item (@{$selections}) {
                   5651:         foreach my $part (@{$psprt}) {
                   5652:             my $rootparmkey=$env{'request.course.id'};
                   5653:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5654:                 $rootparmkey.='.['.$item.']';
                   5655:             }
                   5656:             if ($parmlev eq 'general') {
                   5657: # course-level parameter
                   5658:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5659:                 $$listdata{$newparmkey}=1;
                   5660:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5661:             } elsif ($parmlev eq 'map') {
                   5662: # map-level parameter
1.548     raeburn  5663:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5664:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5665:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5666:                     $$listdata{$newparmkey}=1;
                   5667:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5668:                 }
                   5669:             } else {
                   5670: # resource-level parameter
                   5671:                 foreach my $rid (@{$ids}) {
                   5672:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5673:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5674:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5675:                     $$listdata{$newparmkey}=1;
                   5676:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5677:                 }
                   5678:             }
                   5679:         }
                   5680:     }
                   5681: }
                   5682: 
1.563     damieng  5683: # UI to edit parameter settings starting with a list of all existing parameters.
                   5684: # (called by setoverview action)
                   5685: #
                   5686: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5687: sub overview {
1.568     raeburn  5688:     my ($r,$parm_permission) = @_;
1.208     www      5689:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5690:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5691:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5692:     my $readonly = 1;
                   5693:     if ($parm_permission->{'edit'}) {
                   5694:         undef($readonly);
                   5695:     }
1.549     raeburn  5696:     my $js = '<script type="text/javascript">'."\n".
                   5697:              '// <![CDATA['."\n".
                   5698:              &toggleparmtextbox_js()."\n".
                   5699:              &validateparms_js()."\n".
                   5700:              &ipacc_boxes_js()."\n".
1.558     raeburn  5701:              &done_proctor_js()."\n".
1.588     raeburn  5702:              &deeplink_js()."\n".
1.549     raeburn  5703:              '// ]]>'."\n".
                   5704:              '</script>'."\n";
1.414     droeschl 5705:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5706:     text=>"Overview Mode"});
1.549     raeburn  5707:     my %loaditems = (
                   5708:                       'onload'   => "showHideLenient();",
                   5709:                     );
                   5710: 
                   5711:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5712:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5713:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5714:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5715:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5716: 
1.208     www      5717: # Store modified
                   5718: 
1.568     raeburn  5719:     unless ($readonly) {
                   5720:         &storedata($r,$crs,$dom);
                   5721:     }
1.208     www      5722: 
                   5723: # Read modified data
                   5724: 
1.552     raeburn  5725:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5726: 
1.214     www      5727: 
                   5728:     my $sortorder=$env{'form.sortorder'};
                   5729:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5730:     &sortmenu($r,$sortorder);
                   5731: 
1.568     raeburn  5732:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5733: 
                   5734:     if ($readonly) {
                   5735:         $r->print('<p>'.$submitbutton.'</p>');
                   5736:     }
                   5737: 
1.208     www      5738: # List data
                   5739: 
1.568     raeburn  5740:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5741:     $r->print(&tableend().'<p>');
                   5742:     if ($foundkeys) {
                   5743:         unless ($readonly) {
                   5744:             $r->print('<p>'.$submitbutton.'</p>');
                   5745:         }
                   5746:     } else {
                   5747:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5748:     }
                   5749:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5750: }
1.121     www      5751: 
1.560     damieng  5752: # Unused sub.
1.563     damieng  5753: #
                   5754: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5755: sub clean_parameters {
                   5756:     my ($r) = @_;
                   5757:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5758:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5759: 
1.414     droeschl 5760:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5761:         text=>"Clean Parameters"});
1.333     albertel 5762:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5763:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5764:     $r->print(<<ENDOVER);
                   5765: $start_page
                   5766: $breadcrumbs
                   5767: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5768: ENDOVER
                   5769: # Store modified
                   5770: 
                   5771:     &storedata($r,$crs,$dom);
                   5772: 
                   5773: # Read modified data
                   5774: 
                   5775:     my $resourcedata=&readdata($crs,$dom);
                   5776: 
                   5777: # List data
                   5778: 
                   5779:     $r->print('<h3>'.
1.473     amueller 5780:           &mt('These parameters refer to resources that do not exist.').
                   5781:           '</h3>'.
                   5782:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5783:           '<br />');
1.333     albertel 5784:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5785:           '<tr>'.
                   5786:           '<th>'.&mt('Delete').'</th>'.
                   5787:           '<th>'.&mt('Parameter').'</th>'.
                   5788:           '</tr>');
1.333     albertel 5789:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5790:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5791:             && $thiskey=~/\.type$/);
                   5792:         my %data = &parse_key($thiskey);
                   5793:         if (1) { #exists($data{'realm_exists'})
                   5794:             #&& !$data{'realm_exists'}) {
                   5795:             $r->print(&Apache::loncommon::start_data_table_row().
                   5796:                 '<tr>'.
                   5797:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5798: 
                   5799:             $r->print('<td>');
                   5800:             my $display_value = $resourcedata->{$thiskey};
                   5801:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5802:             $display_value =
                   5803:                 &Apache::lonlocal::locallocaltime($display_value);
                   5804:             }
1.470     raeburn  5805:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5806:             $parmitem = &mt($parmitem);
1.560     damieng  5807:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5808:                 $parmitem,$resourcedata->{$thiskey}));
                   5809:             $r->print('<br />');
                   5810:             if ($data{'scope_type'} eq 'all') {
                   5811:                 $r->print(&mt('All users'));
                   5812:             } elsif ($data{'scope_type'} eq 'user') {
                   5813:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581     raeburn  5814:             } elsif ($data{'scope_type'} eq 'secgroup') {
                   5815:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5816:             }
                   5817:             $r->print('<br />');
                   5818:             if ($data{'realm_type'} eq 'all') {
                   5819:                 $r->print(&mt('All Resources'));
                   5820:             } elsif ($data{'realm_type'} eq 'folder') {
                   5821:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5822:             } elsif ($data{'realm_type'} eq 'symb') {
                   5823:             my ($map,$resid,$url) =
                   5824:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5825:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5826:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5827:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5828:             }
                   5829:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5830:             $r->print('</td></tr>');
                   5831: 
1.473     amueller 5832:         }
1.333     albertel 5833:     }
                   5834:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5835:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5836:           '</p></form>');
                   5837:     &endSettingsScreen($r);
                   5838:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5839: }
                   5840: 
1.563     damieng  5841: # UI to shift all dates (called by dateshift1 action).
                   5842: # Used by overview mode.
                   5843: #
                   5844: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5845: sub date_shift_one {
                   5846:     my ($r) = @_;
                   5847:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5848:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5849:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.594     raeburn  5850:     my $sec = $env{'request.course.sec'};
1.414     droeschl 5851:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5852:         text=>"Shifting Dates"});
1.594     raeburn  5853:     my $submit_text = &mt('Shift all dates accordingly');
                   5854:     if ($sec ne '') {
1.595   ! raeburn  5855:         my @groups;
        !          5856:         if ($env{'request.course.groups'} ne '') {
        !          5857:             @groups = split(/:/,$env{'request.course.groups'});
        !          5858:         }
        !          5859:         if (@groups) {
        !          5860:             $submit_text = &mt("Shift dates set just for your section/group(s), accordingly");
        !          5861:         } else {
        !          5862:             $submit_text = &mt("Shift dates set just for your section, accordingly");
        !          5863:         }
1.594     raeburn  5864:     }
1.390     www      5865:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5866:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5867:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5868:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5869:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5870:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5871:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5872:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5873:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5874:                                                         'timeshifted',
                   5875:                                                         $env{'form.timebase'},,
                   5876:                                                         '').
                   5877:               '</td></tr></table>'.
                   5878:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5879:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
1.594     raeburn  5880:               '<input type="submit" value="'.$submit_text.'" /></form>');
1.507     www      5881:     &endSettingsScreen($r);
1.390     www      5882:     $r->print(&Apache::loncommon::end_page());
                   5883: }
                   5884: 
1.563     damieng  5885: # UI to shift all dates (second form).
                   5886: #
                   5887: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5888: sub date_shift_two {
                   5889:     my ($r) = @_;
                   5890:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5891:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.594     raeburn  5892:     my $sec = $env{'request.course.sec'};
1.531     raeburn  5893:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5894:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5895:         text=>"Shifting Dates"});
1.390     www      5896:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5897:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5898:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5899:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5900:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.594     raeburn  5901:     $r->print('<h2>'.&mt('Shift Dates').'</h2>');
                   5902:     if ($sec ne '') {
1.595   ! raeburn  5903:         my @groups;
        !          5904:         if ($env{'request.course.groups'} ne '') {
        !          5905:             @groups = split(/:/,$env{'request.course.groups'});
        !          5906:         }
        !          5907:         if (@groups) {
        !          5908:             $r->print('<p>'.
        !          5909:                       &mt("Shift dates set just for your section/group(s), such that [_1] becomes [_2]",
        !          5910:                           &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
        !          5911:                           &Apache::lonlocal::locallocaltime($timeshifted)).
        !          5912:                       '</p>');
        !          5913:         } else {
        !          5914:             $r->print('<p>'.
        !          5915:                       &mt("Shift dates set just for your section, such that [_1] becomes [_2]",
        !          5916:                           &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
        !          5917:                           &Apache::lonlocal::locallocaltime($timeshifted)).
        !          5918:                       '</p>');
        !          5919:         }
1.594     raeburn  5920:     } else {
                   5921:         $r->print('<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
                   5922:                             &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
                   5923:                             &Apache::lonlocal::locallocaltime($timeshifted)).
                   5924:                   '</p>');
                   5925:     }
1.390     www      5926:     my $delta=$timeshifted-$env{'form.timebase'};
1.594     raeburn  5927:     my $numchanges = 0;
                   5928:     my $result = &dateshift($delta,\$numchanges);
                   5929:     if ($result eq 'ok') {
                   5930:         $r->print(
                   5931:             &Apache::lonhtmlcommon::confirm_success(&mt('Completed shifting of [quant,_1,date setting]',
                   5932:                                                     $numchanges)));
                   5933:     } elsif ($result eq 'con_delayed') {
                   5934:         $r->print(
                   5935:             &Apache::lonhtmlcommon::confirm_success(&mt('Queued shifting of [quant,_1,date setting]',
                   5936:                                                         $numchanges)));
                   5937:     } else {
                   5938:         $r->print(
                   5939:             &Apache::lonhtmlcommon::confirm_success(&mt('An error occurred attempting to shift dates'),1));
                   5940:     }
1.543     bisitz   5941:     $r->print(
                   5942:         '<br /><br />'.
                   5943:         &Apache::lonhtmlcommon::actionbox(
                   5944:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5945:     &endSettingsScreen($r);
1.390     www      5946:     $r->print(&Apache::loncommon::end_page());
                   5947: }
                   5948: 
1.563     damieng  5949: # Returns the different components of a resourcedata key.
                   5950: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5951: #       realm_exists, parameter_part, parameter_name.
                   5952: # Was used by clean_parameters (which is unused).
                   5953: #
                   5954: # @param {string} $key - the parameter key
                   5955: # @returns {hash}
1.333     albertel 5956: sub parse_key {
                   5957:     my ($key) = @_;
                   5958:     my %data;
                   5959:     my ($middle,$part,$name)=
1.572     damieng  5960:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5961:     $data{'scope_type'} = 'all';
                   5962:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5963:         $data{'scope'} = $1;
                   5964:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5965:             $data{'scope_type'} = 'user';
                   5966:             $data{'scope'} = [$1,$2];
                   5967:         } else {
1.581     raeburn  5968:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5969:         }
                   5970:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5971:     }
                   5972:     $middle=~s/\.+$//;
                   5973:     $middle=~s/^\.+//;
                   5974:     $data{'realm_type'}='all';
                   5975:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5976:         $data{'realm'} = $1;
                   5977:         $data{'realm_type'} = 'folder';
                   5978:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5979:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5980:     } elsif ($middle) {
1.560     damieng  5981:         $data{'realm'} = $middle;
                   5982:         $data{'realm_type'} = 'symb';
                   5983:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5984:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5985:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5986:     }
1.446     bisitz   5987: 
1.333     albertel 5988:     $data{'parameter_part'} = $part;
                   5989:     $data{'parameter_name'} = $name;
                   5990: 
                   5991:     return %data;
                   5992: }
                   5993: 
1.239     raeburn  5994: 
1.563     damieng  5995: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5996: sub header {
1.507     www      5997:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5998: }
1.193     albertel 5999: 
                   6000: 
                   6001: 
1.560     damieng  6002: ##################################################
                   6003: # MAIN MENU
                   6004: ##################################################
                   6005: 
1.563     damieng  6006: # Content and problem settings main menu.
                   6007: #
                   6008: # @param {Apache2::RequestRec} $r - the Apache request
                   6009: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 6010: sub print_main_menu {
                   6011:     my ($r,$parm_permission)=@_;
                   6012:     #
1.414     droeschl 6013:     $r->print(&header());
1.507     www      6014:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  6015:     my $crstype = &Apache::loncommon::course_type();
                   6016:     my $lc_crstype = lc($crstype);
                   6017: 
                   6018:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 6019:     $r->print(<<ENDMAINFORMHEAD);
                   6020: <form method="post" enctype="multipart/form-data"
                   6021:       action="/adm/parmset" name="studentform">
                   6022: ENDMAINFORMHEAD
                   6023: #
1.195     albertel 6024:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6025:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 6026:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 6027:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  6028:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  6029:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   6030:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  6031:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   6032:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   6033:                                         '/'.$env{'request.course.sec'});
                   6034:     }
1.568     raeburn  6035:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   6036:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   6037:                                         '/'.$env{'request.course.sec'});
                   6038:     }
                   6039:     my (%linktext,%linktitle,%url);
                   6040:     if ($parm_permission->{'edit'}) {
                   6041:         %linktext = (
                   6042:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   6043:                      settable        => 'Edit Resource Parameters - Table Mode',
                   6044:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   6045:                     );
                   6046:         %linktitle = (
                   6047:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   6048:                      settable        => 'Set/Modify resource parameters in table mode.',
                   6049:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   6050:                      );
                   6051:     } else {
                   6052:         %linktext = (
                   6053:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   6054:                      settable        => 'View Resource Parameters - Table Mode',
                   6055:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   6056:                    );
                   6057:         %linktitle = (
                   6058:                      newoverview     => 'Display resource parameters in overview mode.',
                   6059:                      settable        => 'Display resource parameters in table mode.',
                   6060:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   6061:                      );
                   6062:     }
                   6063:     if ($mgr) {
                   6064:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   6065:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   6066:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   6067:     } elsif ($vgr) {
                   6068:         $linktext{'resettimes'} = 'Display Student Access Times',
                   6069:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   6070:         $url{'resettimes'} = '/adm/accesstimes';
                   6071:     }
1.193     albertel 6072:     my @menu =
1.507     www      6073:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 6074:         items => [
                   6075:           { linktext => 'Portfolio Metadata',
                   6076:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  6077:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  6078:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 6079:             icon =>'contact-new.png'   ,
                   6080:             },
1.568     raeburn  6081:           { linktext => $linktext{'resettimes'},
                   6082:             url => $url{'resettimes'},
                   6083:             permission => ($vgr || $mgr),
                   6084:             linktitle => $linktitle{'resettimes'},
                   6085:             icon => 'start-here.png',
1.473     amueller 6086:             },
1.520     raeburn  6087:           { linktext => 'Blocking Communication/Resource Access',
                   6088:             url => '/adm/setblock',
1.568     raeburn  6089:             permission => ($vcb || $dcm),
1.520     raeburn  6090:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   6091:             icon => 'comblock.png',
                   6092:             },
1.473     amueller 6093:           { linktext => 'Set Parameter Setting Default Actions',
                   6094:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  6095:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 6096:             linktitle =>'Set default actions for parameters.'  ,
                   6097:             icon => 'folder-new.png'  ,
                   6098:             }]},
                   6099:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   6100:         items => [
                   6101:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   6102:             url => '/adm/helper/parameter.helper',
1.568     raeburn  6103:             permission => $parm_permission->{'helper'},
1.473     amueller 6104:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   6105:             icon => 'dialog-information.png'  ,
                   6106:             #help => 'Parameter_Helper',
                   6107:             },
1.568     raeburn  6108:           { linktext => $linktext{'newoverview'},
1.473     amueller 6109:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  6110:             permission => $parm_permission->{'newoverview'},
                   6111:             linktitle => $linktitle{'newoverview'},
                   6112:             icon => 'edit-find.png',
1.473     amueller 6113:             #help => 'Parameter_Overview',
                   6114:             },
1.568     raeburn  6115:           { linktext => $linktext{'settable'},
1.473     amueller 6116:             url => '/adm/parmset?action=settable',
1.568     raeburn  6117:             permission => $parm_permission->{'settable'},
                   6118:             linktitle => $linktitle{'settable'},
                   6119:             icon => 'edit-copy.png',
1.473     amueller 6120:             #help => 'Table_Mode',
                   6121:             }]},
1.417     droeschl 6122:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 6123:          items => [
1.570     raeburn  6124:           { linktext => $linktext{'setoverview'},
1.473     amueller 6125:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  6126:             permission => $parm_permission->{'setoverview'},
                   6127:             linktitle => $linktitle{'setoverview'},
                   6128:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 6129:             #help => 'Parameter_Overview',
                   6130:             },
                   6131:           { linktext => 'Change Log',
                   6132:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  6133:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  6134:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 6135:             icon => 'document-properties.png',
1.473     amueller 6136:             }]}
1.193     albertel 6137:           );
1.414     droeschl 6138:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  6139:     $r->print('</form>');
1.507     www      6140:     &endSettingsScreen($r);
1.539     raeburn  6141:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 6142:     return;
                   6143: }
1.414     droeschl 6144: 
1.416     jms      6145: 
                   6146: 
1.560     damieng  6147: ##################################################
                   6148: # PORTFOLIO METADATA
                   6149: ##################################################
                   6150: 
1.563     damieng  6151: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   6152: # It looks like field titles are not localized.
                   6153: #
                   6154: # @param {Apache2::RequestRec} $r - the Apache request
                   6155: # @param {string} $field_name - metadata field name
                   6156: # @param {string} $field_text - metadata field title, in English unless manually added
                   6157: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 6158: sub output_row {
1.347     banghart 6159:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 6160:     my $output;
1.263     banghart 6161:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   6162:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 6163:     if (!defined($options)) {
1.254     banghart 6164:         $options = 'active,stuadd';
1.261     banghart 6165:         $values = '';
1.252     banghart 6166:     }
1.337     banghart 6167:     if (!($options =~ /deleted/)) {
                   6168:         my @options= ( ['active', 'Show to student'],
1.418     schafran 6169:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 6170:                     ['choices','Provide choices for students to select from']);
1.473     amueller 6171: #           ['onlyone','Student may select only one choice']);
1.337     banghart 6172:         if ($added_flag) {
                   6173:             push @options,['deleted', 'Delete Metadata Field'];
                   6174:         }
1.351     banghart 6175:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   6176:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 6177:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 6178:         foreach my $opt (@options) {
1.560     damieng  6179:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   6180:             $output .= &Apache::loncommon::continue_data_table_row();
                   6181:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   6182:                     <input type="checkbox" name="'.
                   6183:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   6184:                     &mt($opt->[1]).'</label></td>';
                   6185:             $output .= &Apache::loncommon::end_data_table_row();
                   6186:         }
1.351     banghart 6187:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   6188:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 6189:         $output .= &Apache::loncommon::end_data_table_row();
                   6190:         my $multiple_checked;
                   6191:         my $single_checked;
                   6192:         if ($options =~ m/onlyone/) {
1.422     bisitz   6193:             $multiple_checked = '';
1.423     bisitz   6194:             $single_checked = ' checked="checked"';
1.351     banghart 6195:         } else {
1.423     bisitz   6196:             $multiple_checked = ' checked="checked"';
1.422     bisitz   6197:             $single_checked = '';
1.351     banghart 6198:         }
1.560     damieng  6199:         $output .= &Apache::loncommon::continue_data_table_row();
                   6200:         $output .= '<td>'.('&nbsp;' x 10).'
                   6201:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   6202:                     '.&mt('Student may select multiple choices from list').'</td>';
                   6203:         $output .= &Apache::loncommon::end_data_table_row();
                   6204:         $output .= &Apache::loncommon::continue_data_table_row();
                   6205:         $output .= '<td>'.('&nbsp;' x 10).'
                   6206:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   6207:                     '.&mt('Student may select only one choice from list').'</td>';
                   6208:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 6209:     }
                   6210:     return ($output);
                   6211: }
1.416     jms      6212: 
                   6213: 
1.560     damieng  6214: # UI to order portfolio metadata fields.
1.563     damieng  6215: # Currently useless because addmetafield does not work.
                   6216: #
                   6217: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 6218: sub order_meta_fields {
                   6219:     my ($r)=@_;
                   6220:     my $idx = 1;
                   6221:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6222:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6223:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 6224:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  6225:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6226:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6227:         text=>"Add Metadata Field"});
1.560     damieng  6228:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6229:         {href=>"/adm/parmset?action=setrestrictmeta",
                   6230:         text=>"Restrict Metadata"},
                   6231:         {text=>"Order Metadata"});
1.345     banghart 6232:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  6233:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 6234:     if ($env{'form.storeorder'}) {
                   6235:         my $newpos = $env{'form.newpos'} - 1;
                   6236:         my $currentpos = $env{'form.currentpos'} - 1;
                   6237:         my @neworder = ();
1.548     raeburn  6238:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6239:         my $i;
1.341     banghart 6240:         if ($newpos > $currentpos) {
1.340     banghart 6241:         # moving stuff up
                   6242:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  6243:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6244:             }
                   6245:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  6246:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 6247:             }
                   6248:             $neworder[$newpos]=$oldorder[$currentpos];
                   6249:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  6250:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6251:             }
                   6252:         } else {
                   6253:         # moving stuff down
1.473     amueller 6254:             for ($i=0;$i<$newpos;$i++) {
                   6255:                 $neworder[$i]=$oldorder[$i];
                   6256:             }
                   6257:             $neworder[$newpos]=$oldorder[$currentpos];
                   6258:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   6259:                 $neworder[$i]=$oldorder[$i-1];
                   6260:             }
                   6261:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   6262:                 $neworder[$i]=$oldorder[$i];
                   6263:             }
1.340     banghart 6264:         }
1.560     damieng  6265:         my $ordered_fields = join ",", @neworder;
1.343     banghart 6266:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  6267:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6268:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 6269:     }
1.357     raeburn  6270:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 6271:     my $ordered_fields;
1.548     raeburn  6272:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6273:     if (!@fields_in_order) {
                   6274:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  6275:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 6276:             push @fields_in_order, $key;
1.341     banghart 6277:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 6278:         }
1.341     banghart 6279:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   6280:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6281:     }
1.340     banghart 6282:     $r->print('<table>');
                   6283:     my $num_fields = scalar(@fields_in_order);
                   6284:     foreach my $key (@fields_in_order) {
                   6285:         $r->print('<tr><td>');
                   6286:         $r->print('<form method="post" action="">');
1.537     bisitz   6287:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 6288:         for (my $i = 1;$i le $num_fields;$i ++) {
                   6289:             if ($i eq $idx) {
                   6290:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   6291:             } else {
                   6292:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   6293:             }
                   6294:         }
                   6295:         $r->print('</select></td><td>');
                   6296:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   6297:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   6298:         $r->print('</form>');
                   6299:         $r->print($$fields{$key}.'</td></tr>');
                   6300:         $idx ++;
                   6301:     }
                   6302:     $r->print('</table>');
1.507     www      6303:     &endSettingsScreen($r);
1.340     banghart 6304:     return 'ok';
                   6305: }
1.416     jms      6306: 
                   6307: 
1.563     damieng  6308: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   6309: # @returns {string}
1.359     banghart 6310: sub continue {
                   6311:     my $output;
                   6312:     $output .= '<form action="" method="post">';
                   6313:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
1.586     raeburn  6314:     $output .= '<input type="submit" value="'.&mt('Continue').'" />';
1.359     banghart 6315:     return ($output);
                   6316: }
1.416     jms      6317: 
                   6318: 
1.563     damieng  6319: # UI to add a metadata field.
                   6320: # Currenly does not work because of an HTML error (the field is not visible).
                   6321: #
                   6322: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 6323: sub addmetafield {
                   6324:     my ($r)=@_;
1.414     droeschl 6325:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6326:         text=>"Add Metadata Field"});
1.334     banghart 6327:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   6328:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 6329:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6330:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6331:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6332:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 6333:     if (exists($env{'form.undelete'})) {
1.358     banghart 6334:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 6335:         foreach my $meta_field(@meta_fields) {
                   6336:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   6337:             $options =~ s/deleted//;
                   6338:             $options =~ s/,,/,/;
                   6339:             my $put_result = &Apache::lonnet::put('environment',
                   6340:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   6341: 
1.586     raeburn  6342:             $r->print(&mt('Undeleted Metadata Field [_1] with result [_2]',
                   6343:                           '<strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}.
                   6344:                           '</strong>',$put_result).
                   6345:                       '<br />');
1.339     banghart 6346:         }
1.359     banghart 6347:         $r->print(&continue());
1.339     banghart 6348:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 6349:         my $meta_field = $env{'form.fieldname'};
                   6350:         my $display_field = $env{'form.fieldname'};
                   6351:         $meta_field =~ s/\W/_/g;
1.338     banghart 6352:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 6353:         my $put_result = &Apache::lonnet::put('environment',
                   6354:                             {'metadata.'.$meta_field.'.values'=>"",
                   6355:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   6356:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.586     raeburn  6357:         $r->print(&mt('Added new Metadata Field [_1] with result [_2]',
                   6358:                       '<strong>'.$env{'form.fieldname'}.'</strong>',$put_result).
                   6359:                   '<br />');
1.359     banghart 6360:         $r->print(&continue());
1.335     banghart 6361:     } else {
1.357     raeburn  6362:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 6363:         if ($fields) {
1.586     raeburn  6364:             $r->print(&mt('You may undelete previously deleted fields.').
                   6365:                       '<br />'.
                   6366:                       &mt('Check those you wish to undelete and click Undelete.').
                   6367:                       '<br />');
1.339     banghart 6368:             $r->print('<form method="post" action="">');
                   6369:             foreach my $key(keys(%$fields)) {
1.581     raeburn  6370:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 6371:             }
1.586     raeburn  6372:             $r->print('<input type="submit" name="undelete" value="'.&mt('Undelete').'" />');
1.339     banghart 6373:             $r->print('</form>');
                   6374:         }
1.586     raeburn  6375:         $r->print('<hr />'.
                   6376:                   &mt('[_1]Or[_2] you may enter a new metadata field name.',
                   6377:                       '<strong>','</strong>').
1.581     raeburn  6378:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 6379:         $r->print('<input type="text" name="fieldname" /><br />');
1.586     raeburn  6380:         $r->print('<input type="submit" value="'.&mt('Add Metadata Field').'" />');
1.581     raeburn  6381:         $r->print('</form>');
1.334     banghart 6382:     }
1.507     www      6383:     &endSettingsScreen($r);
1.334     banghart 6384: }
1.416     jms      6385: 
                   6386: 
                   6387: 
1.560     damieng  6388: # Display or save portfolio metadata.
1.563     damieng  6389: #
                   6390: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 6391: sub setrestrictmeta {
1.240     banghart 6392:     my ($r)=@_;
1.242     banghart 6393:     my $next_meta;
1.244     banghart 6394:     my $output;
1.245     banghart 6395:     my $item_num;
1.246     banghart 6396:     my $put_result;
1.414     droeschl 6397:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 6398:         text=>"Restrict Metadata"});
1.280     albertel 6399:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 6400:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 6401:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6402:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6403:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6404:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 6405:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 6406:     my $save_field = '';
1.586     raeburn  6407:     my %lt = &Apache::lonlocal::texthash(
                   6408:                                            addm => 'Add Metadata Field',
                   6409:                                            ordm => 'Order Metadata Fields',
                   6410:                                            save => 'Save',
                   6411:                                         );
1.259     banghart 6412:     if ($env{'form.restrictmeta'}) {
1.254     banghart 6413:         foreach my $field (sort(keys(%env))) {
1.252     banghart 6414:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 6415:                 my $options;
1.252     banghart 6416:                 my $meta_field = $1;
                   6417:                 my $meta_key = $2;
1.253     banghart 6418:                 if ($save_field ne $meta_field) {
1.252     banghart 6419:                     $save_field = $meta_field;
1.473     amueller 6420:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   6421:                         $options.='stuadd,';
                   6422:                     }
                   6423:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   6424:                         $options.='choices,';
                   6425:                     }
                   6426:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   6427:                         $options.='onlyone,';
                   6428:                     }
                   6429:                     if ($env{'form.'.$meta_field.'_active'}) {
                   6430:                         $options.='active,';
                   6431:                     }
                   6432:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   6433:                         $options.='deleted,';
                   6434:                     }
1.259     banghart 6435:                     my $name = $save_field;
1.560     damieng  6436:                     $put_result = &Apache::lonnet::put('environment',
                   6437:                         {'metadata.'.$meta_field.'.options'=>$options,
                   6438:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   6439:                         },$dom,$crs);
1.252     banghart 6440:                 }
                   6441:             }
                   6442:         }
                   6443:     }
1.296     albertel 6444:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 6445:                        {'freshen_cache' => 1});
1.335     banghart 6446:     # Get the default metadata fields
1.258     albertel 6447:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 6448:     # Now get possible added metadata fields
1.357     raeburn  6449:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.347     banghart 6450:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 6451:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 6452:         if ($field ne 'courserestricted') {
1.586     raeburn  6453:             $output.= &output_row($r,$field,$metadata_fields{$field});
1.560     damieng  6454:         }
1.255     banghart 6455:     }
1.351     banghart 6456:     my $buttons = (<<ENDButtons);
1.586     raeburn  6457:         <input type="submit" name="restrictmeta" value="$lt{'save'}" />
1.351     banghart 6458:         </form><br />
                   6459:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
1.586     raeburn  6460:         <input type="submit" name="restrictmeta" value="$lt{'addm'}" />
1.351     banghart 6461:         </form>
                   6462:         <br />
                   6463:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
1.586     raeburn  6464:         <input type="submit" name="restrictmeta" value="$lt{'ordm'}" />
1.351     banghart 6465: ENDButtons
1.337     banghart 6466:     my $added_flag = 1;
1.335     banghart 6467:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.586     raeburn  6468:         $output.= &output_row($r,$field,$$added_metadata_fields{$field},$added_flag);
1.335     banghart 6469:     }
1.347     banghart 6470:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   6471:     $r->print(<<ENDenv);
1.259     banghart 6472:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 6473:         $output
1.351     banghart 6474:         $buttons
1.340     banghart 6475:         </form>
1.244     banghart 6476: ENDenv
1.507     www      6477:     &endSettingsScreen($r);
1.280     albertel 6478:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 6479:     return 'ok';
                   6480: }
1.416     jms      6481: 
                   6482: 
1.563     damieng  6483: # Returns metadata fields that have been manually added.
                   6484: #
                   6485: # @param {string} $cid - course id
                   6486: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 6487: sub get_added_meta_fieldnames {
1.357     raeburn  6488:     my ($cid) = @_;
1.335     banghart 6489:     my %fields;
                   6490:     foreach my $key(%env) {
1.357     raeburn  6491:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 6492:             my $field_name = $1;
                   6493:             my ($display_field_name) = $env{$key};
                   6494:             $fields{$field_name} = $display_field_name;
                   6495:         }
                   6496:     }
                   6497:     return \%fields;
                   6498: }
1.416     jms      6499: 
                   6500: 
1.563     damieng  6501: # Returns metadata fields that have been manually added and deleted.
                   6502: #
                   6503: # @param {string} $cid - course id
                   6504: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 6505: sub get_deleted_meta_fieldnames {
1.357     raeburn  6506:     my ($cid) = @_;
1.339     banghart 6507:     my %fields;
                   6508:     foreach my $key(%env) {
1.357     raeburn  6509:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 6510:             my $field_name = $1;
                   6511:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   6512:                 my ($display_field_name) = $env{$key};
                   6513:                 $fields{$field_name} = $display_field_name;
                   6514:             }
                   6515:         }
                   6516:     }
                   6517:     return \%fields;
                   6518: }
1.560     damieng  6519: 
                   6520: 
                   6521: ##################################################
                   6522: # PARAMETER SETTINGS DEFAULT ACTIONS
                   6523: ##################################################
                   6524: 
                   6525: # UI to change parameter setting default actions
1.563     damieng  6526: #
                   6527: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6528: sub defaultsetter {
1.280     albertel 6529:     my ($r) = @_;
                   6530: 
1.414     droeschl 6531:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6532:         text=>"Set Defaults"});
1.531     raeburn  6533:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6534:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6535:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6536:     my $start_page =
1.531     raeburn  6537:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6538:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6539:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6540:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6541:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6542: 
1.221     www      6543:     my @ids=();
                   6544:     my %typep=();
                   6545:     my %keyp=();
                   6546:     my %allparms=();
                   6547:     my %allparts=();
                   6548:     my %allmaps=();
                   6549:     my %mapp=();
                   6550:     my %symbp=();
                   6551:     my %maptitles=();
                   6552:     my %uris=();
                   6553:     my %keyorder=&standardkeyorder();
                   6554:     my %defkeytype=();
                   6555: 
1.446     bisitz   6556:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6557:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6558:                 \%keyorder,\%defkeytype);
1.224     www      6559:     if ($env{'form.storerules'}) {
1.560     damieng  6560:         my %newrules=();
                   6561:         my @delrules=();
                   6562:         my %triggers=();
                   6563:         foreach my $key (keys(%env)) {
1.225     albertel 6564:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6565:                 my $tempkey=$1;
                   6566:                 my $action=$env{$key};
1.226     www      6567:                 if ($action) {
1.560     damieng  6568:                     $newrules{$tempkey.'_action'}=$action;
                   6569:                     if ($action ne 'default') {
                   6570:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6571:                         $triggers{$whichparm}.=$tempkey.':';
                   6572:                     }
                   6573:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6574:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6575:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6576:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6577:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6578:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6579:                     } else {
                   6580:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6581:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6582:                     }
                   6583:                 } else {
                   6584:                     push(@delrules,$tempkey.'_action');
                   6585:                     push(@delrules,$tempkey.'_type');
                   6586:                     push(@delrules,$tempkey.'_hours');
                   6587:                     push(@delrules,$tempkey.'_min');
                   6588:                     push(@delrules,$tempkey.'_sec');
                   6589:                     push(@delrules,$tempkey.'_value');
                   6590:                 }
1.473     amueller 6591:             }
                   6592:         }
1.560     damieng  6593:         foreach my $key (keys(%allparms)) {
                   6594:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6595:         }
1.560     damieng  6596:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6597:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6598:         &resetrulescache();
1.224     www      6599:     }
1.227     www      6600:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6601:                        'hours' => 'Hours',
                   6602:                        'min' => 'Minutes',
                   6603:                        'sec' => 'Seconds',
                   6604:                        'yes' => 'Yes',
                   6605:                        'no' => 'No');
1.222     www      6606:     my @standardoptions=('','default');
                   6607:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6608:     my @dateoptions=('','default');
                   6609:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6610:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6611:         unless ($tempkey) { next; }
                   6612:         push @standardoptions,'when_setting_'.$tempkey;
                   6613:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6614:         if (&isdateparm($defkeytype{$tempkey})) {
                   6615:             push @dateoptions,'later_than_'.$tempkey;
                   6616:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6617:             push @dateoptions,'earlier_than_'.$tempkey;
                   6618:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6619:         }
1.222     www      6620:     }
1.563     damieng  6621:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6622:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6623:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6624:           &Apache::loncommon::start_data_table_header_row().
                   6625:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6626:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6627:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6628:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6629:         unless ($tempkey) { next; }
                   6630:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6631:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6632:         my $action=&rulescache($tempkey.'_action');
                   6633:         $r->print('<select name="'.$tempkey.'_action">');
                   6634:         if (&isdateparm($defkeytype{$tempkey})) {
                   6635:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6636:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6637:             $r->print("\n<option value='$dateoptions[$i]'".
                   6638:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6639:                 ">$datedisplay[$i]</option>");
                   6640:             }
                   6641:         } else {
                   6642:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6643:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6644:             $r->print("\n<option value='$standardoptions[$i]'".
                   6645:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6646:                 ">$standarddisplay[$i]</option>");
                   6647:             }
1.473     amueller 6648:         }
1.560     damieng  6649:         $r->print('</select>');
                   6650:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6651:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6652:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6653:         }
1.560     damieng  6654:         $r->print("\n</td><td>\n");
1.222     www      6655: 
1.221     www      6656:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6657:             my $days=&rulescache($tempkey.'_days');
                   6658:             my $hours=&rulescache($tempkey.'_hours');
                   6659:             my $min=&rulescache($tempkey.'_min');
                   6660:             my $sec=&rulescache($tempkey.'_sec');
                   6661:             $r->print(<<ENDINPUTDATE);
                   6662:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6663:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6664:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6665:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6666: ENDINPUTDATE
1.560     damieng  6667:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6668:                 my $yeschecked='';
                   6669:                 my $nochecked='';
                   6670:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6671:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6672: 
                   6673:             $r->print(<<ENDYESNO);
                   6674:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6675:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6676: ENDYESNO
1.221     www      6677:         } else {
1.560     damieng  6678:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6679:         }
1.318     albertel 6680:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6681:     }
1.318     albertel 6682:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6683:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6684:           &mt('Save').'" /></form>'."\n");
                   6685:     &endSettingsScreen($r);
                   6686:     $r->print(&Apache::loncommon::end_page());
1.220     www      6687:     return;
                   6688: }
1.193     albertel 6689: 
1.560     damieng  6690: ##################################################
                   6691: # PARAMETER CHANGES LOG
                   6692: ##################################################
                   6693: 
1.563     damieng  6694: # Returns some info for a parameter log entry.
                   6695: # Returned entries:
                   6696: # $realm - HTML title for the parameter level and resource
                   6697: # $section - parameter section
                   6698: # $name - parameter name
                   6699: # $part - parameter part
                   6700: # $what - $part.'.'.$name
                   6701: # $middle - resource symb ?
                   6702: # $uname - user name (same as given)
                   6703: # $udom - user domain (same as given)
                   6704: # $issection - section or group name
                   6705: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6706: #
                   6707: # @param {string} $key - parameter log key
                   6708: # @param {string} $uname - user name
                   6709: # @param {string} $udom - user domain
                   6710: # @param {boolean} $typeflag - .type log entry
                   6711: # @returns {Array}
1.290     www      6712: sub components {
1.581     raeburn  6713:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6714: 
                   6715:     if ($typeflag) {
1.560     damieng  6716:         $key=~s/\.type$//;
1.290     www      6717:     }
1.330     albertel 6718: 
                   6719:     my ($middle,$part,$name)=
1.572     damieng  6720:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6721:     my $issection;
1.330     albertel 6722: 
1.290     www      6723:     my $section=&mt('All Students');
                   6724:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6725:         $issection=$1;
                   6726:         $section=&mt('Group/Section').': '.$issection;
                   6727:         $middle=~s/^\[(.*)\]//;
1.290     www      6728:     }
                   6729:     $middle=~s/\.+$//;
                   6730:     $middle=~s/^\.+//;
1.291     www      6731:     if ($uname) {
1.560     damieng  6732:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6733:         $issection='';
1.291     www      6734:     }
1.316     albertel 6735:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6736:     my $realmdescription=&mt('all resources');
1.556     raeburn  6737:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6738:         my $mapurl = $1;
                   6739:         my $maplevel = $2;
                   6740:         my $leveltitle = &mt('Folder/Map');
                   6741:         if ($maplevel eq 'rec') {
                   6742:             $leveltitle = &mt('Recursive');
                   6743:         }
1.560     damieng  6744:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6745:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6746:             $mapurl.')</span></span>';
                   6747:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6748:     } elsif ($middle) {
                   6749:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6750:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6751:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6752:             ' in '.$map.' id: '.$id.')</span></span>';
                   6753:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6754:     }
1.291     www      6755:     my $what=$part.'.'.$name;
1.330     albertel 6756:     return ($realm,$section,$name,$part,
1.473     amueller 6757:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6758: }
1.293     www      6759: 
1.563     damieng  6760: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6761: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6762: 
1.563     damieng  6763: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6764: sub load_parameter_names {
1.583     raeburn  6765:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 6766:     while (my $configline=<$config>) {
1.560     damieng  6767:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6768:         chomp($configline);
                   6769:         my ($short,$plain)=split(/:/,$configline);
                   6770:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6771:         if ($type eq 'display') {
                   6772:             $standard_parms{$name} = $plain;
1.469     raeburn  6773:         } elsif ($type eq 'type') {
1.560     damieng  6774:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6775:         }
1.328     albertel 6776:     }
                   6777:     close($config);
                   6778:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6779:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6780:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6781: }
                   6782: 
1.563     damieng  6783: # Returns a parameter title for standard parameters, the name for others.
                   6784: #
                   6785: # @param {string} $name - parameter name
                   6786: # @returns {string}
1.292     www      6787: sub standard_parameter_names {
                   6788:     my ($name)=@_;
1.328     albertel 6789:     if (!%standard_parms) {
1.560     damieng  6790:         &load_parameter_names();
1.328     albertel 6791:     }
1.292     www      6792:     if ($standard_parms{$name}) {
1.560     damieng  6793:         return $standard_parms{$name};
1.446     bisitz   6794:     } else {
1.560     damieng  6795:         return $name;
1.292     www      6796:     }
                   6797: }
1.290     www      6798: 
1.563     damieng  6799: # Returns a parameter type for standard parameters, undef for others.
                   6800: #
                   6801: # @param {string} $name - parameter name
                   6802: # @returns {string}
1.469     raeburn  6803: sub standard_parameter_types {
                   6804:     my ($name)=@_;
                   6805:     if (!%standard_parms_types) {
                   6806:         &load_parameter_names();
                   6807:     }
                   6808:     if ($standard_parms_types{$name}) {
                   6809:         return $standard_parms_types{$name};
                   6810:     }
                   6811:     return;
                   6812: }
1.309     www      6813: 
1.563     damieng  6814: # Returns a parameter level title (not localized) from the parameter level name.
                   6815: #
                   6816: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6817: # @returns {string}
1.557     raeburn  6818: sub standard_parameter_levels {
                   6819:     my ($name)=@_;
                   6820:     my %levels = (
                   6821:                     'resourcelevel'   => 'a single resource',
                   6822:                     'maplevel'        => 'the enclosing map/folder', 
                   6823:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6824:                     'courselevel'     => 'the general (course) level',
                   6825:                  );
                   6826:     if ($levels{$name}) {
                   6827:         return $levels{$name};
                   6828:     }
                   6829:     return;
                   6830: }
                   6831: 
1.560     damieng  6832: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6833: #
                   6834: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6835: sub parm_change_log {
1.568     raeburn  6836:     my ($r,$parm_permission)=@_;
1.531     raeburn  6837:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6838:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6839:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6840:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6841:     text=>"Parameter Change Log"});
1.522     raeburn  6842:     my $js = '<script type="text/javascript">'."\n".
                   6843:              '// <![CDATA['."\n".
                   6844:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6845:              '// ]]>'."\n".
                   6846:              '</script>'."\n";
                   6847:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6848:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6849:     &startSettingsScreen($r,'parmset',$crstype);
                   6850:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6851: 
1.301     www      6852:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6853: 
1.522     raeburn  6854:     $r->print('<div class="LC_left_float">'.
                   6855:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6856:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6857:                      method="post" name="parameterlog">');
1.446     bisitz   6858: 
1.311     albertel 6859:     my %saveable_parameters = ('show' => 'scalar',);
                   6860:     &Apache::loncommon::store_course_settings('parameter_log',
                   6861:                                               \%saveable_parameters);
                   6862:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6863:                                                 \%saveable_parameters);
1.522     raeburn  6864:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6865:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6866:               '</form></fieldset></div><br clear="all" />');
1.301     www      6867: 
1.568     raeburn  6868:     my $readonly = 1;
                   6869:     if ($parm_permission->{'edit'}) {
                   6870:         undef($readonly);
                   6871:     }
1.531     raeburn  6872:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6873:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6874:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6875:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6876:     unless ($readonly) {
                   6877:         $r->print('<th>'.&mt('Announce').'</th>');
                   6878:     }
                   6879:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6880:     my $shown=0;
1.349     www      6881:     my $folder='';
                   6882:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6883:         my $last='';
                   6884:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6885:                 &GDBM_READER(),0640)) {
                   6886:             $last=$hash{'last_known'};
                   6887:             untie(%hash);
                   6888:         }
                   6889:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6890:     }
1.595   ! raeburn  6891:     my $numgroups = 0;
        !          6892:     my @groups;
        !          6893:     if ($env{'request.course.groups'} ne '') {
        !          6894:         @groups = split(/:/,$env{'request.course.groups'});
        !          6895:         $numgroups = scalar(@groups);
        !          6896:     }
1.560     damieng  6897:     foreach my $id (sort {
                   6898:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6899:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6900:                 }
                   6901:                 my $aid = (split('00000',$a))[-1];
                   6902:                 my $bid = (split('00000',$b))[-1];
                   6903:                 return $bid<=>$aid;
1.473     amueller 6904:             } (keys(%parmlog))) {
1.294     www      6905:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6906:         my $count = 0;
                   6907:         my $time =
                   6908:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6909:         my $plainname =
                   6910:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6911:                         $parmlog{$id}{'exe_udom'});
                   6912:         my $about_me_link =
                   6913:             &Apache::loncommon::aboutmewrapper($plainname,
                   6914:                             $parmlog{$id}{'exe_uname'},
                   6915:                             $parmlog{$id}{'exe_udom'});
                   6916:         my $send_msg_link='';
1.568     raeburn  6917:         if ((!$readonly) && 
                   6918:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6919:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6920:             $send_msg_link ='<br />'.
                   6921:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6922:                             $parmlog{$id}{'exe_uname'},
                   6923:                             $parmlog{$id}{'exe_udom'});
                   6924:         }
                   6925:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6926:         my $makenewrow=0;
                   6927:         my %istype=();
                   6928:         my $output;
                   6929:         foreach my $changed (reverse(sort(@changes))) {
                   6930:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6931:             my $typeflag = ($changed =~/\.type$/ &&
                   6932:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6933:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581     raeburn  6934:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6935:             if ($env{'request.course.sec'} ne '') {
1.595   ! raeburn  6936:                 next if (($issection ne '') && (!(($issection eq $env{'request.course.sec'}) ||
        !          6937:                                                   ($numgroups && (grep(/^\Q$issection\E$/,@groups))))));
1.560     damieng  6938:                 if ($uname ne '') {
                   6939:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6940:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6941:                 }
                   6942:             }
                   6943:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6944:                 if ($folder) {
                   6945:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6946:                 }
                   6947:             }
                   6948:             if ($typeflag) {
                   6949:                 $istype{$parmname}=$value;
                   6950:                 if (!$env{'form.includetypes'}) { next; }
                   6951:             }
                   6952:             $count++;
                   6953:             if ($makenewrow) {
                   6954:                 $output .= $row_start;
                   6955:             } else {
                   6956:                 $makenewrow=1;
                   6957:             }
1.470     raeburn  6958:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6959:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6960:                 &mt($parmitem).'</td><td>'.
                   6961:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6962:             my $stillactive=0;
                   6963:             if ($parmlog{$id}{'delflag'}) {
                   6964:                 $output .= &mt('Deleted');
                   6965:             } else {
                   6966:                 if ($typeflag) {
1.470     raeburn  6967:                     my $parmitem = &standard_parameter_names($value); 
                   6968:                     $parmitem = &mt($parmitem);
1.560     damieng  6969:                     $output .= &mt('Type: [_1]',$parmitem);
                   6970:                 } else {
1.584     raeburn  6971:                     my $toolsymb;
                   6972:                     if ($middle =~ /ext\.tool$/) {
                   6973:                         $toolsymb = $middle;
                   6974:                     }
1.560     damieng  6975:                     my ($level,@all)=&parmval_by_symb($what,$middle,
1.584     raeburn  6976:                         &Apache::lonnet::metadata($middle,$what,$toolsymb),
1.560     damieng  6977:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6978:                     my $showvalue = $value;
                   6979:                     if ($istype{$parmname} eq '') {
                   6980:                         my $type = &standard_parameter_types($parmname);
                   6981:                         if ($type ne '') {
                   6982:                             if (&isdateparm($type)) {
                   6983:                                 $showvalue =
                   6984:                                     &Apache::lonlocal::locallocaltime($value);
                   6985:                             }
                   6986:                         }
                   6987:                     } else {
1.560     damieng  6988:                         if (&isdateparm($istype{$parmname})) {
                   6989:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6990:                         }
1.469     raeburn  6991:                     }
                   6992:                     $output .= $showvalue;
1.560     damieng  6993:                     if ($value ne $all[$level]) {
                   6994:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6995:                     } else {
                   6996:                         $stillactive=1;
                   6997:                     }
                   6998:                 }
1.473     amueller 6999:             }
1.568     raeburn  7000:             $output .= '</td>';
                   7001: 
                   7002:             unless ($readonly) { 
                   7003:                 $output .= '<td>';
                   7004:                 if ($stillactive) {
                   7005:                     my $parmitem = &standard_parameter_names($parmname);
                   7006:                     $parmitem = &mt($parmitem);
                   7007:                     my $title=&mt('Changed [_1]',$parmitem);
                   7008:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   7009:                         $parmitem,$realmdescription,
                   7010:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   7011:                     if (($uname) && ($udom)) {
                   7012:                         $output .=
                   7013:                         &Apache::loncommon::messagewrapper('Notify User',
                   7014:                                                            $uname,$udom,$title,
                   7015:                                                            $description);
                   7016:                     } else {
                   7017:                         $output .=
                   7018:                             &Apache::lonrss::course_blog_link($id,$title,
                   7019:                                                               $description);
                   7020:                     }
1.560     damieng  7021:                 }
1.568     raeburn  7022:                 $output .= '</td>';
1.560     damieng  7023:             }
1.568     raeburn  7024:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 7025:         }
1.560     damieng  7026:         if ($env{'form.displayfilter'} eq 'containing') {
                   7027:             my $wholeentry=$about_me_link.':'.
                   7028:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   7029:             $output;
                   7030:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 7031:         }
1.349     www      7032:         if ($count) {
1.560     damieng  7033:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   7034:                         <td rowspan="'.$count.'">'.$about_me_link.
                   7035:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   7036:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   7037:             $send_msg_link.'</td>'.$output);
                   7038:             $shown++;
                   7039:         }
                   7040:         if (!($env{'form.show'} eq &mt('all')
                   7041:             || $shown<=$env{'form.show'})) { last; }
1.286     www      7042:     }
1.301     www      7043:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      7044:     &endSettingsScreen($r);
1.284     www      7045:     $r->print(&Apache::loncommon::end_page());
                   7046: }
                   7047: 
1.560     damieng  7048: ##################################################
                   7049: # MISC !
                   7050: ##################################################
                   7051: 
1.563     damieng  7052: # Stores slot information.
1.560     damieng  7053: # Used by table UI
1.563     damieng  7054: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   7055: #
                   7056: # @param {string} $slot_name - slot name
                   7057: # @param {string} $cdom - course domain
                   7058: # @param {string} $cnum - course number
                   7059: # @param {string} $symb - resource symb
                   7060: # @param {string} $uname - user name
                   7061: # @param {string} $udom - user domain
                   7062: # @returns {string} - 'ok' or error name
1.437     raeburn  7063: sub update_slots {
                   7064:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   7065:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   7066:     if (!keys(%slot)) {
                   7067:         return 'error: slot does not exist';
                   7068:     }
                   7069:     my $max=$slot{'maxspace'};
                   7070:     if (!defined($max)) { $max=99999; }
                   7071: 
                   7072:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   7073:                                        "^$slot_name\0");
                   7074:     my ($tmp)=%consumed;
                   7075:     if ($tmp=~/^error: 2 / ) {
                   7076:         return 'error: unable to determine current slot status';
                   7077:     }
                   7078:     my $last=0;
                   7079:     foreach my $key (keys(%consumed)) {
                   7080:         my $num=(split('\0',$key))[1];
                   7081:         if ($num > $last) { $last=$num; }
                   7082:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   7083:             return 'ok';
                   7084:         }
                   7085:     }
                   7086: 
                   7087:     if (scalar(keys(%consumed)) >= $max) {
                   7088:         return 'error: no space left in slot';
                   7089:     }
                   7090:     my $wanted=$last+1;
                   7091: 
                   7092:     my %reservation=('name'      => $uname.':'.$udom,
                   7093:                      'timestamp' => time,
                   7094:                      'symb'      => $symb);
                   7095: 
                   7096:     my $success=&Apache::lonnet::newput('slot_reservations',
                   7097:                                         {"$slot_name\0$wanted" =>
                   7098:                                              \%reservation},
                   7099:                                         $cdom, $cnum);
1.438     raeburn  7100:     if ($success eq 'ok') {
                   7101:         my %storehash = (
                   7102:                           symb    => $symb,
                   7103:                           slot    => $slot_name,
                   7104:                           action  => 'reserve',
                   7105:                           context => 'parameter',
                   7106:                         );
1.526     raeburn  7107:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7108:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  7109: 
1.526     raeburn  7110:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7111:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  7112:     }
1.437     raeburn  7113:     return $success;
                   7114: }
                   7115: 
1.563     damieng  7116: # Deletes a slot reservation.
1.560     damieng  7117: # Used by table UI
1.563     damieng  7118: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   7119: #
                   7120: # @param {string} $slot_name - slot name
                   7121: # @param {string} $cdom - course domain
                   7122: # @param {string} $cnum - course number
                   7123: # @param {string} $uname - user name
                   7124: # @param {string} $udom - user domain
                   7125: # @param {string} $symb - resource symb
                   7126: # @returns {string} - 'ok' or error name
1.437     raeburn  7127: sub delete_slots {
                   7128:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   7129:     my $delresult;
                   7130:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   7131:                                          $cnum, "^$slot_name\0");
                   7132:     if (&Apache::lonnet::error(%consumed)) {
                   7133:         return 'error: unable to determine current slot status';
                   7134:     }
                   7135:     my ($tmp)=%consumed;
                   7136:     if ($tmp=~/^error: 2 /) {
                   7137:         return 'error: unable to determine current slot status';
                   7138:     }
                   7139:     foreach my $key (keys(%consumed)) {
                   7140:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   7141:             my $num=(split('\0',$key))[1];
                   7142:             my $entry = $slot_name.'\0'.$num;
                   7143:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   7144:                                               $cdom,$cnum);
                   7145:             if ($delresult eq 'ok') {
                   7146:                 my %storehash = (
                   7147:                                   symb    => $symb,
                   7148:                                   slot    => $slot_name,
                   7149:                                   action  => 'release',
                   7150:                                   context => 'parameter',
                   7151:                                 );
1.526     raeburn  7152:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7153:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  7154:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7155:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  7156:             }
                   7157:         }
                   7158:     }
                   7159:     return $delresult;
                   7160: }
                   7161: 
1.563     damieng  7162: # Returns true if there is a current course.
1.560     damieng  7163: # Used by handler
1.563     damieng  7164: #
                   7165: # @returns {boolean}
1.355     albertel 7166: sub check_for_course_info {
                   7167:     my $navmap = Apache::lonnavmaps::navmap->new();
                   7168:     return 1 if ($navmap);
                   7169:     return 0;
                   7170: }
                   7171: 
1.563     damieng  7172: # Returns the current course host and host LON-CAPA version.
                   7173: #
                   7174: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  7175: sub parameter_release_vars { 
1.504     raeburn  7176:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7177:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   7178:    my $chostname = &Apache::lonnet::hostname($chome);
                   7179:    my ($cmajor,$cminor) = 
                   7180:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   7181:    return ($chostname,$cmajor,$cminor);
                   7182: }
                   7183: 
1.563     damieng  7184: # Checks if the course host version can handle a parameter required version,
                   7185: # and if it does, stores the release needed for the course.
                   7186: #
                   7187: # @param {string} $name - parameter name
                   7188: # @param {string} $value - parameter value
                   7189: # @param {string} $valmatch - name of the test used for checking the value
                   7190: # @param {string} $namematch - name of the test used for checking the name
                   7191: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   7192: # @param {integer} $cmajor - course major version number
                   7193: # @param {integer} $cminor - course minor version number
                   7194: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  7195: sub parameter_releasecheck {
1.557     raeburn  7196:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  7197:     my $needsnewer;
                   7198:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   7199:     if (($cmajor < $needsmajor) || 
                   7200:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   7201:         $needsnewer = 1;
1.557     raeburn  7202:     } elsif ($name) {
                   7203:         if ($valmatch) {
                   7204:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   7205:         } elsif ($value) { 
                   7206:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   7207:         }
                   7208:     } elsif ($namematch) {
                   7209:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  7210:     }
                   7211:     return $needsnewer;
                   7212: }
                   7213: 
1.568     raeburn  7214: sub get_permission {
                   7215:     my %permission;
                   7216:     my $allowed = 0;
                   7217:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   7218:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   7219:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   7220:                   $env{'request.course.sec'}))) {
                   7221:         %permission= (
                   7222:                        'edit'               => 1,
                   7223:                        'set'                => 1,
                   7224:                        'setoverview'        => 1,
                   7225:                        'addmetadata'        => 1,
                   7226:                        'ordermetadata'      => 1,
                   7227:                        'setrestrictmeta'    => 1,
                   7228:                        'newoverview'        => 1,
                   7229:                        'setdefaults'        => 1,
                   7230:                        'settable'           => 1,
                   7231:                        'parameterchangelog' => 1,
                   7232:                        'cleanparameters'    => 1,
                   7233:                        'dateshift1'         => 1,
                   7234:                        'dateshift2'         => 1,
                   7235:                        'helper'             => 1,
                   7236:          );
                   7237:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   7238:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   7239:                   $env{'request.course.sec'}))) {
                   7240:         %permission = (
                   7241:                        'set'                => 1,
                   7242:                        'settable'           => 1,
                   7243:                        'newoverview'        => 1,
                   7244:                        'setoverview'        => 1,
                   7245:                        'parameterchangelog' => 1,
                   7246:                       );
                   7247:     }
                   7248:     foreach my $perm (values(%permission)) {
                   7249:         if ($perm) { $allowed=1; last; }
                   7250:     }
                   7251:     return (\%permission,$allowed);
                   7252: }
                   7253: 
1.560     damieng  7254: ##################################################
                   7255: # HANDLER
                   7256: ##################################################
                   7257: 
                   7258: # Main handler for lonparmset.
                   7259: # Sub called based on request parameters action and command:
                   7260: # no command or action: print_main_menu
                   7261: # command 'set': assessparms (direct access to table mode for a resource)
                   7262: #                (this can also be accessed simply with the symb parameter)
                   7263: # action 'setoverview': overview (display all existing parameter settings)
                   7264: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   7265: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   7266: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   7267: # action 'newoverview': newoverview (overview mode)
                   7268: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   7269: # action 'settable': assessparms (table mode)
                   7270: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   7271: #                              blog postings, user notification changes)
                   7272: # action 'cleanparameters': clean_parameters (unused)
                   7273: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   7274: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      7275: sub handler {
1.43      albertel 7276:     my $r=shift;
1.30      www      7277: 
1.376     albertel 7278:     &reset_caches();
                   7279: 
1.414     droeschl 7280:     &Apache::loncommon::content_type($r,'text/html');
                   7281:     $r->send_http_header;
                   7282:     return OK if $r->header_only;
                   7283: 
1.193     albertel 7284:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 7285:                         ['action','state',
1.205     www      7286:                                              'pres_marker',
                   7287:                                              'pres_value',
1.206     www      7288:                                              'pres_type',
1.506     www      7289:                                              'filter','part',
1.390     www      7290:                                              'udom','uname','symb','serial','timebase']);
1.131     www      7291: 
1.83      bowersj2 7292: 
1.193     albertel 7293:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 7294:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      7295:                         text=>"Content and Problem Settings",
1.473     amueller 7296:                         faq=>10,
                   7297:                         bug=>'Instructor Interface',
1.442     droeschl 7298:                                             help =>
                   7299:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      7300: 
1.30      www      7301: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  7302:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 7303:     my $exists = &check_for_course_info();
                   7304: 
1.568     raeburn  7305:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 7306:         #
                   7307:         # Main switch on form.action and form.state, as appropriate
                   7308:         #
                   7309:         # Check first if coming from someone else headed directly for
                   7310:         #  the table mode
1.568     raeburn  7311:         if (($parm_permission->{'set'}) && 
                   7312:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   7313:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   7314:             &assessparms($r,$parm_permission);
1.193     albertel 7315:         } elsif (! exists($env{'form.action'})) {
                   7316:             &print_main_menu($r,$parm_permission);
1.568     raeburn  7317:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   7318:             &print_main_menu($r,$parm_permission);
1.414     droeschl 7319:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  7320:             &overview($r,$parm_permission);
1.560     damieng  7321:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   7322:             &addmetafield($r);
                   7323:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   7324:             &order_meta_fields($r);
1.414     droeschl 7325:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  7326:             &setrestrictmeta($r);
1.414     droeschl 7327:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  7328:             &newoverview($r,$parm_permission);
1.414     droeschl 7329:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  7330:             &defaultsetter($r);
                   7331:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  7332:             &assessparms($r,$parm_permission);
1.414     droeschl 7333:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  7334:             &parm_change_log($r,$parm_permission);
1.414     droeschl 7335:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  7336:             &clean_parameters($r);
1.414     droeschl 7337:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      7338:             &date_shift_one($r);
1.414     droeschl 7339:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      7340:             &date_shift_two($r);
1.446     bisitz   7341:         }
1.43      albertel 7342:     } else {
1.1       www      7343: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  7344:         if ($exists) {
                   7345:             $env{'user.error.msg'}=
                   7346:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   7347:         } else {
                   7348:             $env{'user.error.msg'}=
                   7349:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   7350:         }
                   7351:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 7352:     }
1.376     albertel 7353:     &reset_caches();
                   7354: 
1.43      albertel 7355:     return OK;
1.1       www      7356: }
                   7357: 
                   7358: 1;
                   7359: __END__
                   7360: 
                   7361: 

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