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

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

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