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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.592   ! raeburn     4: # $Id: lonparmset.pm,v 1.591 2019/03/02 15:40:14 raeburn Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
1.579     raeburn    39: lonparmset provides an interface to setting content parameters in a 
                     40: course.
1.560     damieng    41: 
                     42: It contains all the code for the "Content and Problem Settings" UI, except
                     43: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
                     44: and lonblockingmenu.pm.
1.59      matthew    45: 
                     46: =head1 DESCRIPTION
                     47: 
                     48: This module sets coursewide and assessment parameters.
                     49: 
                     50: =head1 INTERNAL SUBROUTINES
                     51: 
1.416     jms        52: =over
1.59      matthew    53: 
1.416     jms        54: =item parmval()
1.59      matthew    55: 
                     56: Figure out a cascading parameter.
                     57: 
1.71      albertel   58: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   59:          $id   - a bighash Id number
1.71      albertel   60:          $def  - the resource's default value   'stupid emacs
                     61: 
1.556     raeburn    62: Returns:  A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71      albertel   63: 
1.556     raeburn    64: 18 - General Course
                     65: 17 - Map or Folder level in course (recursive) 
                     66: 16 - Map or Folder level in course (non-recursive)
                     67: 15 - resource default
                     68: 14 - map default
                     69: 13 - resource level in course
                     70: 12 - General for section
                     71: 11 - Map or Folder level for section (recursive)
                     72: 10 - Map or Folder level for section (non-recursive)
                     73: 9 - resource level in section
                     74: 8 - General for group
                     75: 7 - Map or Folder level for group (recursive)
                     76: 6 - Map or Folder level for group (non-recursive)
                     77: 5 - resource level in group
                     78: 4 - General for specific student
                     79: 3 - Map or Folder level for specific student (recursive)
                     80: 2 - Map or Folder level for specific student (non-recursive)
1.71      albertel   81: 1 - resource level for specific student
1.2       www        82: 
1.416     jms        83: =item parmval_by_symb()
                     84: 
                     85: =item reset_caches()
                     86: 
                     87: =item cacheparmhash() 
                     88: 
                     89: =item parmhash()
                     90: 
                     91: =item symbcache()
                     92: 
                     93: =item preset_defaults()
                     94: 
                     95: =item date_sanity_info()
                     96: 
                     97: =item storeparm()
                     98: 
                     99: Store a parameter by symb
                    100: 
                    101:     Takes
                    102:     - symb
                    103:     - name of parameter
                    104:     - level
                    105:     - new value
                    106:     - new type
                    107:     - username
                    108:     - userdomain
                    109: 
                    110: =item log_parmset()
                    111: 
                    112: =item storeparm_by_symb_inner()
                    113: 
                    114: =item valout()
                    115: 
                    116: Format a value for output.
                    117: 
                    118: Inputs:  $value, $type, $editable
                    119: 
                    120: Returns: $value, formatted for output.  If $type indicates it is a date,
                    121: localtime($value) is returned.
                    122: $editable will return an icon to click on
                    123: 
                    124: =item plink()
                    125: 
                    126: Produces a link anchor.
                    127: 
                    128: Inputs: $type,$dis,$value,$marker,$return,$call
                    129: 
                    130: Returns: scalar with html code for a link which will envoke the 
                    131: javascript function 'pjump'.
                    132: 
                    133: =item page_js()
                    134: 
                    135: =item startpage()
                    136: 
                    137: =item print_row()
                    138: 
                    139: =item print_td()
                    140: 
1.580     raeburn   141: =item check_other_groups()
1.416     jms       142: 
                    143: =item parm_control_group()
                    144: 
                    145: =item extractResourceInformation() : 
                    146: 
1.512     foxr      147:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       148: 
1.542     raeburn   149: Input: See list below
                    150: 
                    151: =over 4
1.416     jms       152: 
1.512     foxr      153: =item * B<env{'user.name'}> : Current username
1.416     jms       154: 
1.512     foxr      155: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       156: 
1.542     raeburn   157: =item * B<env{"request.course.fn"}> : Course
                    158: 
                    159: =back
1.416     jms       160: 
1.512     foxr      161: Outputs: See list below:
1.416     jms       162: 
1.542     raeburn   163: =over 4
                    164: 
1.512     foxr      165: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       166: 
1.512     foxr      167: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416     jms       168: 
1.512     foxr      169: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416     jms       170: 
1.512     foxr      171: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       172: 
1.512     foxr      173: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    174: 
                    175: =item * B<allmaps> (out) : hash, ???
1.416     jms       176: 
                    177: =item * B<mapp> : ??
                    178: 
                    179: =item * B<symbp> : hash, id->full sym?
                    180: 
1.512     foxr      181: =item * B<maptitles>
                    182: 
                    183: =item * B<uris>
1.416     jms       184: 
1.512     foxr      185: =item * B<keyorder>
                    186: 
                    187: =item * B<defkeytype>
1.416     jms       188: 
1.542     raeburn   189: =back
                    190: 
1.416     jms       191: =item isdateparm()
                    192: 
                    193: =item parmmenu()
                    194: 
                    195: =item partmenu()
                    196: 
                    197: =item usermenu()
                    198: 
                    199: =item displaymenu()
                    200: 
                    201: =item mapmenu()
                    202: 
                    203: =item levelmenu()
                    204: 
                    205: =item sectionmenu()
                    206: 
                    207: =item keysplit()
                    208: 
                    209: =item keysinorder()
                    210: 
                    211: =item keysinorder_bytype()
                    212: 
                    213: =item keysindisplayorder()
                    214: 
                    215: =item standardkeyorder()
                    216: 
                    217: =item assessparms() : 
                    218: 
                    219: Show assessment data and parameters.  This is a large routine that should
                    220: be simplified and shortened... someday.
                    221: 
1.513     foxr      222: Inputs: $r - the Apache request object.
                    223:   
1.416     jms       224: Returns: nothing
                    225: 
                    226: Variables used (guessed by Jeremy):
                    227: 
1.542     raeburn   228: =over
                    229: 
1.416     jms       230: =item * B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
                    231: 
                    232: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    233: 
                    234: =item * B<@catmarker> contains list of all possible parameters including part #s
                    235: 
                    236: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    237: 
                    238: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    239:         When storing information, store as part 0
                    240:         When requesting information, request from full part
                    241: 
1.542     raeburn   242: =back
                    243: 
1.416     jms       244: =item tablestart()
                    245: 
                    246: =item tableend()
                    247: 
                    248: =item extractuser()
                    249: 
                    250: =item parse_listdata_key()
                    251: 
                    252: =item listdata()
                    253: 
                    254: =item date_interval_selector()
                    255: 
                    256: =item get_date_interval_from_form()
                    257: 
                    258: =item default_selector()
                    259: 
                    260: =item string_selector()
                    261: 
                    262: =item dateshift()
                    263: 
                    264: =item newoverview()
                    265: 
                    266: =item secgroup_lister()
                    267: 
                    268: =item overview()
                    269: 
                    270: =item clean_parameters()
                    271: 
                    272: =item date_shift_one()
                    273: 
                    274: =item date_shift_two()
                    275: 
                    276: =item parse_key()
                    277: 
                    278: =item header()
                    279: 
                    280: Output html header for page
                    281: 
                    282: =item print_main_menu()
                    283: 
                    284: =item output_row()
                    285: 
                    286: Set portfolio metadata
                    287: 
                    288: =item order_meta_fields()
                    289: 
                    290: =item addmetafield()
                    291: 
                    292: =item setrestrictmeta()
                    293: 
                    294: =item get_added_meta_fieldnames()
                    295: 
                    296: =item get_deleted_meta_fieldnames()
                    297: 
                    298: =item defaultsetter()
                    299: 
                    300: =item components()
                    301: 
                    302: =item load_parameter_names()
                    303: 
                    304: =item parm_change_log()
                    305: 
                    306: =item handler() : 
                    307: 
1.450     raeburn   308: Main handler.  Calls &assessparms subroutine.
1.416     jms       309: 
                    310: =back
                    311: 
1.59      matthew   312: =cut
                    313: 
1.416     jms       314: ###################################################################
                    315: ###################################################################
                    316: 
                    317: package Apache::lonparmset;
                    318: 
                    319: use strict;
                    320: use Apache::lonnet;
                    321: use Apache::Constants qw(:common :http REDIRECT);
                    322: use Apache::lonhtmlcommon();
                    323: use Apache::loncommon;
                    324: use GDBM_File;
                    325: use Apache::lonhomework;
                    326: use Apache::lonxml;
                    327: use Apache::lonlocal;
                    328: use Apache::lonnavmaps;
                    329: use Apache::longroup;
                    330: use Apache::lonrss;
1.506     www       331: use HTML::Entities;
1.416     jms       332: use LONCAPA qw(:DEFAULT :match);
                    333: 
                    334: 
1.560     damieng   335: ##################################################
                    336: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
                    337: ##################################################
                    338: 
                    339: # Page header
1.561     damieng   340: #
                    341: # @param {Apache2::RequestRec} $r - Apache request object
                    342: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
                    343: # @param {string} $crstype - course type ('Community' for community settings)
1.507     www       344: sub startSettingsScreen {
1.531     raeburn   345:     my ($r,$mode,$crstype)=@_;
1.507     www       346: 
1.531     raeburn   347:     my $tabtext = &mt('Course Settings');
                    348:     if ($crstype eq 'Community') {
                    349:         $tabtext = &mt('Community Settings');
                    350:     } 
1.507     www       351:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
                    352:     $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.531     raeburn   353:                                           $tabtext.
1.507     www       354:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    355: 
1.523     raeburn   356:     $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507     www       357:                                                                  &mt('Content and Problem Settings').'</b></a></li>');
                    358:     $r->print("\n".'</ul>'."\n");
1.523     raeburn   359:     $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507     www       360: }
                    361: 
1.560     damieng   362: # Page footer
1.507     www       363: sub endSettingsScreen {
                    364:    my ($r)=@_;
                    365:    $r->print('</div></div></div>');
                    366: }
                    367: 
                    368: 
                    369: 
1.560     damieng   370: ##################################################
1.563     damieng   371: # (mostly) TABLE MODE
1.560     damieng   372: # (parmval is also used for the log of parameter changes)
                    373: ##################################################
                    374: 
1.566     damieng   375: # Calls parmval_by_symb, getting the symb from $id with &symbcache.
1.561     damieng   376: #
                    377: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   378: # @param {string} $id - resource id or map pc
1.561     damieng   379: # @param {string} $def - the resource's default value for this parameter
                    380: # @param {string} $uname - user name
                    381: # @param {string} $udom - user domain
                    382: # @param {string} $csec - section name
                    383: # @param {string} $cgroup - group name
                    384: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    385: # @returns {Array}
1.2       www       386: sub parmval {
1.275     raeburn   387:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    388:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    389:                                                            $cgroup,$courseopt);
1.201     www       390: }
                    391: 
1.561     damieng   392: # Returns an array containing
                    393: # - the most specific level that is defined for that parameter (integer)
                    394: # - an array with the level as index and the parameter value as value (when defined)
                    395: #   (level 1 is the most specific and will have precedence)
                    396: #
                    397: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   398: # @param {string} $symb - resource symb or map src
1.561     damieng   399: # @param {string} $def - the resource's default value for this parameter
                    400: # @param {string} $uname - user name
                    401: # @param {string} $udom - user domain
                    402: # @param {string} $csec - section name
                    403: # @param {string} $cgroup - group name
                    404: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    405: # @returns {Array}
1.201     www       406: sub parmval_by_symb {
1.275     raeburn   407:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       408: 
1.352     albertel  409:     my $useropt;
                    410:     if ($uname ne '' && $udom ne '') {
1.561     damieng   411:         $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  412:     }
1.200     www       413: 
1.8       www       414:     my $result='';
1.44      albertel  415:     my @outpar=();
1.2       www       416: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    417:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  418:     $map = &Apache::lonnet::deversion($map);
1.561     damieng   419:     
                    420:     # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
                    421:     # any change should be reflected there.
                    422:     
1.201     www       423:     my $symbparm=$symb.'.'.$what;
1.556     raeburn   424:     my $recurseparm=$map.'___(rec).'.$what; 
1.201     www       425:     my $mapparm=$map.'___(all).'.$what;
1.10      www       426: 
1.269     raeburn   427:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    428:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   429:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   430:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    431: 
1.190     albertel  432:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    433:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   434:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  435:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    436: 
                    437:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    438:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   439:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  440:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       441: 
1.11      www       442: 
1.182     albertel  443: # --------------------------------------------------------- first, check course
1.11      www       444: 
1.561     damieng   445: # 18 - General Course
1.200     www       446:     if (defined($$courseopt{$courselevel})) {
1.556     raeburn   447:         $outpar[18]=$$courseopt{$courselevel};
                    448:         $result=18;
                    449:     }
                    450: 
1.561     damieng   451: # 17 - Map or Folder level in course (recursive) 
1.556     raeburn   452:     if (defined($$courseopt{$courseleveli})) {
                    453:         $outpar[17]=$$courseopt{$courseleveli};
                    454:         $result=17;
1.43      albertel  455:     }
1.11      www       456: 
1.561     damieng   457: # 16 - Map or Folder level in course (non-recursive)
1.200     www       458:     if (defined($$courseopt{$courselevelm})) {
1.556     raeburn   459:         $outpar[16]=$$courseopt{$courselevelm};
                    460:         $result=16;
1.43      albertel  461:     }
1.11      www       462: 
1.182     albertel  463: # ------------------------------------------------------- second, check default
                    464: 
1.561     damieng   465: # 15 - resource default
1.556     raeburn   466:     if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182     albertel  467: 
                    468: # ------------------------------------------------------ third, check map parms
                    469: 
1.556     raeburn   470:     
1.561     damieng   471: # 14 - map default
1.376     albertel  472:     my $thisparm=&parmhash($symbparm);
1.556     raeburn   473:     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182     albertel  474: 
1.561     damieng   475: # 13 - resource level in course
1.200     www       476:     if (defined($$courseopt{$courselevelr})) {
1.556     raeburn   477:         $outpar[13]=$$courseopt{$courselevelr};
                    478:         $result=13;
1.43      albertel  479:     }
1.11      www       480: 
1.182     albertel  481: # ------------------------------------------------------ fourth, back to course
1.352     albertel  482:     if ($csec ne '') {
1.561     damieng   483: # 12 - General for section
1.200     www       484:         if (defined($$courseopt{$seclevel})) {
1.556     raeburn   485:             $outpar[12]=$$courseopt{$seclevel};
                    486:             $result=12;
                    487:         }
1.561     damieng   488: # 11 - Map or Folder level for section (recursive)
1.556     raeburn   489:         if (defined($$courseopt{$secleveli})) {
                    490:             $outpar[11]=$$courseopt{$secleveli};
                    491:             $result=11;
                    492:         }
1.561     damieng   493: # 10 - Map or Folder level for section (non-recursive)
1.200     www       494:         if (defined($$courseopt{$seclevelm})) {
1.556     raeburn   495:             $outpar[10]=$$courseopt{$seclevelm};
                    496:             $result=10;
                    497:         }
1.561     damieng   498: # 9 - resource level in section
1.200     www       499:         if (defined($$courseopt{$seclevelr})) {
1.556     raeburn   500:             $outpar[9]=$$courseopt{$seclevelr};
                    501:             $result=9;
                    502:         }
1.43      albertel  503:     }
1.275     raeburn   504: # ------------------------------------------------------ fifth, check course group
1.352     albertel  505:     if ($cgroup ne '') {
1.561     damieng   506: # 8 - General for group
1.269     raeburn   507:         if (defined($$courseopt{$grplevel})) {
1.556     raeburn   508:             $outpar[8]=$$courseopt{$grplevel};
                    509:             $result=8;
                    510:         }
1.561     damieng   511: # 7 - Map or Folder level for group (recursive)
1.556     raeburn   512:         if (defined($$courseopt{$grpleveli})) {
                    513:             $outpar[7]=$$courseopt{$grpleveli};
                    514:             $result=7;
1.269     raeburn   515:         }
1.561     damieng   516: # 6 - Map or Folder level for group (non-recursive)
1.269     raeburn   517:         if (defined($$courseopt{$grplevelm})) {
1.556     raeburn   518:             $outpar[6]=$$courseopt{$grplevelm};
                    519:             $result=6;
1.269     raeburn   520:         }
1.561     damieng   521: # 5 - resource level in group
1.269     raeburn   522:         if (defined($$courseopt{$grplevelr})) {
1.556     raeburn   523:             $outpar[5]=$$courseopt{$grplevelr};
                    524:             $result=5;
1.269     raeburn   525:         }
                    526:     }
1.11      www       527: 
1.556     raeburn   528: # ---------------------------------------------------------- sixth, check user
1.11      www       529: 
1.352     albertel  530:     if ($uname ne '') {
1.561     damieng   531: # 4 - General for specific student
                    532:         if (defined($$useropt{$courselevel})) {
                    533:             $outpar[4]=$$useropt{$courselevel};
                    534:             $result=4;
                    535:         }
1.556     raeburn   536: 
1.561     damieng   537: # 3 - Map or Folder level for specific student (recursive)
                    538:         if (defined($$useropt{$courseleveli})) {
                    539:             $outpar[3]=$$useropt{$courseleveli};
                    540:             $result=3;
                    541:         }
1.473     amueller  542: 
1.561     damieng   543: # 2 - Map or Folder level for specific student (non-recursive)
                    544:         if (defined($$useropt{$courselevelm})) {
                    545:             $outpar[2]=$$useropt{$courselevelm};
                    546:             $result=2;
                    547:         }
1.473     amueller  548: 
1.561     damieng   549: # 1 - resource level for specific student
                    550:         if (defined($$useropt{$courselevelr})) {
                    551:             $outpar[1]=$$useropt{$courselevelr};
                    552:             $result=1;
                    553:         }
1.43      albertel  554:     }
1.44      albertel  555:     return ($result,@outpar);
1.2       www       556: }
                    557: 
1.198     www       558: 
                    559: 
1.376     albertel  560: # --- Caches local to lonparmset
                    561: 
1.446     bisitz    562: 
1.561     damieng   563: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376     albertel  564: sub reset_caches {
                    565:     &resetparmhash();
                    566:     &resetsymbcache();
                    567:     &resetrulescache();
1.203     www       568: }
                    569: 
1.561     damieng   570: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
                    571: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376     albertel  572: {
1.561     damieng   573:     my $parmhashid; # course identifier, to initialize the cache only once for a course
                    574:     my %parmhash; # the parameter cache
                    575:     # reset map parameter hash
1.376     albertel  576:     sub resetparmhash {
1.560     damieng   577:         undef($parmhashid);
                    578:         undef(%parmhash);
1.376     albertel  579:     }
1.446     bisitz    580: 
1.561     damieng   581:     # dump the _parms.db database into %parmhash
1.376     albertel  582:     sub cacheparmhash {
1.560     damieng   583:         if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    584:         my %parmhashfile;
                    585:         if (tie(%parmhashfile,'GDBM_File',
                    586:             $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    587:             %parmhash=%parmhashfile;
                    588:             untie(%parmhashfile);
                    589:             $parmhashid=$env{'request.course.fn'};
                    590:         }
1.201     www       591:     }
1.446     bisitz    592: 
1.561     damieng   593:     # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376     albertel  594:     sub parmhash {
1.560     damieng   595:         my ($id) = @_;
                    596:         &cacheparmhash();
                    597:         return $parmhash{$id};
1.376     albertel  598:     }
1.560     damieng   599: }
1.376     albertel  600: 
1.566     damieng   601: # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
1.446     bisitz    602: {
1.561     damieng   603:     my $symbsid; # course identifier, to initialize the cache only once for a course
                    604:     my %symbs; # hash id->symb
                    605:     # reset the id->symb cache
1.376     albertel  606:     sub resetsymbcache {
1.560     damieng   607:         undef($symbsid);
                    608:         undef(%symbs);
1.376     albertel  609:     }
1.446     bisitz    610: 
1.566     damieng   611:     # returns the resource symb or map src corresponding to a resource id or map pc
                    612:     # (using lonnavmaps and a cache)
1.376     albertel  613:     sub symbcache {
1.560     damieng   614:         my $id=shift;
                    615:         if ($symbsid ne $env{'request.course.id'}) {
                    616:             undef(%symbs);
                    617:         }
                    618:         if (!$symbs{$id}) {
                    619:             my $navmap = Apache::lonnavmaps::navmap->new();
                    620:             if ($id=~/\./) {
                    621:                 my $resource=$navmap->getById($id);
                    622:                 $symbs{$id}=$resource->symb();
                    623:             } else {
                    624:                 my $resource=$navmap->getByMapPc($id);
                    625:                 $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    626:             }
                    627:             $symbsid=$env{'request.course.id'};
1.473     amueller  628:         }
1.560     damieng   629:         return $symbs{$id};
1.473     amueller  630:     }
1.560     damieng   631: }
1.201     www       632: 
1.561     damieng   633: # cache for parameter default actions (stored in parmdefactions.db)
1.446     bisitz    634: {
1.561     damieng   635:     my $rulesid; # course identifier, to initialize the cache only once for a course
                    636:     my %rules; # parameter default actions hash
1.376     albertel  637:     sub resetrulescache {
1.560     damieng   638:         undef($rulesid);
                    639:         undef(%rules);
1.376     albertel  640:     }
1.446     bisitz    641: 
1.561     damieng   642:     # returns the value for a given key in the parameter default action hash
1.376     albertel  643:     sub rulescache {
1.560     damieng   644:         my $id=shift;
                    645:         if ($rulesid ne $env{'request.course.id'}
                    646:             && !defined($rules{$id})) {
                    647:             my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    648:             my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    649:             %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    650:             $rulesid=$env{'request.course.id'};
                    651:         }
                    652:         return $rules{$id};
1.221     www       653:     }
                    654: }
                    655: 
1.416     jms       656: 
1.561     damieng   657: # Returns the values of the parameter type default action
                    658: # "default value when manually setting".
                    659: # If none is defined, ('','','','','') is returned.
                    660: #
                    661: # @param {string} $type - parameter type
                    662: # @returns {Array<string>} - (hours, min, sec, value)
1.229     www       663: sub preset_defaults {
                    664:     my $type=shift;
                    665:     if (&rulescache($type.'_action') eq 'default') {
1.560     damieng   666:         # yes, there is something
                    667:         return (&rulescache($type.'_hours'),
                    668:             &rulescache($type.'_min'),
                    669:             &rulescache($type.'_sec'),
                    670:             &rulescache($type.'_value'));
1.229     www       671:     } else {
1.560     damieng   672:         # nothing there or something else
                    673:         return ('','','','','');
1.229     www       674:     }
                    675: }
                    676: 
1.416     jms       677: 
1.561     damieng   678: # Checks that a date is after enrollment start date and before
                    679: # enrollment end date.
                    680: # Returns HTML with a warning if it is not, or the empty string otherwise.
                    681: # This is used by both overview and table modes.
                    682: #
                    683: # @param {integer} $checkdate - the date to check.
                    684: # @returns {string} - HTML possibly containing a localized warning message.
1.277     www       685: sub date_sanity_info {
                    686:    my $checkdate=shift;
                    687:    unless ($checkdate) { return ''; }
                    688:    my $result='';
                    689:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    690:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    691:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    692:          $result.='<div class="LC_warning">'
                    693:                  .&mt('After course enrollment end!')
                    694:                  .'</div>';
1.277     www       695:       }
                    696:    }
                    697:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    698:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    699:          $result.='<div class="LC_warning">'
                    700:                  .&mt('Before course enrollment start!')
                    701:                  .'</div>';
1.277     www       702:       }
                    703:    }
1.413     bisitz    704: # Preparation for additional warnings about dates in the past/future.
                    705: # An improved, more context sensitive version is recommended,
                    706: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    707: #   if ($checkdate<time) {
                    708: #      $result.='<div class="LC_info">'
                    709: #              .'('.&mt('in the past').')'
                    710: #              .'</div>';
                    711: #      }
                    712: #   if ($checkdate>time) {
                    713: #      $result.='<div class="LC_info">'
                    714: #              .'('.&mt('in the future').')'
                    715: #              .'</div>';
                    716: #      }
1.277     www       717:    return $result;
                    718: }
1.561     damieng   719: 
                    720: 
                    721: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186     www       722: #
1.566     damieng   723: # @param {string} $sresid - resource id or map pc
1.565     damieng   724: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   725: # @param {integer} $snum - level
                    726: # @param {string} $nval - new value
                    727: # @param {string} $ntype - new type
                    728: # @param {string} $uname - username
                    729: # @param {string} $udom - userdomain
                    730: # @param {string} $csec - section name
                    731: # @param {string} $cgroup - group name
1.186     www       732: sub storeparm {
1.269     raeburn   733:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   734:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       735: }
                    736: 
1.561     damieng   737: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
                    738: 
                    739: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
                    740: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
                    741: #
1.566     damieng   742: # @param {string} $symb - resource symb or map src
1.565     damieng   743: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   744: # @param {integer} $snum - level
                    745: # @param {string} $nval - new value
                    746: # @param {string} $ntype - new type
                    747: # @param {string} $uname - username
                    748: # @param {string} $udom - userdomain
                    749: # @param {string} $csec - section name
                    750: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
                    751: # @param {string} $cgroup - group name
1.197     www       752: sub storeparm_by_symb {
1.275     raeburn   753:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       754:     unless ($recflag) {
1.560     damieng   755:         # first time call
                    756:         %recstack=();
                    757:         $recflag=1;
1.226     www       758:     }
1.560     damieng   759:     # store parameter
1.226     www       760:     &storeparm_by_symb_inner
1.473     amueller  761:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560     damieng   762:     # don't do anything if parameter was reset
1.266     www       763:     unless ($nval) { return; }
1.226     www       764:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560     damieng   765:     # remember that this was set
1.226     www       766:     $recstack{$parm}=1;
1.560     damieng   767:     # what does this trigger?
1.226     www       768:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560     damieng   769:         # don't backfire
                    770:         unless ((!$triggered) || ($recstack{$triggered})) {
                    771:             my $action=&rulescache($triggered.'_action');
                    772:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    773:             # set triggered parameter on same level
                    774:             my $newspnam=$prefix.$triggered;
                    775:             my $newvalue='';
                    776:             my $active=1;
                    777:             if ($action=~/^when\_setting/) {
                    778:             # are there restrictions?
                    779:                 if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    780:                     $active=0;
1.565     damieng   781:                     foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560     damieng   782:                         if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    783:                     }
                    784:                 }
                    785:                 $newvalue=&rulescache($triggered.'_value');
                    786:             } else {
                    787:                 my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    788:                 if ($action=~/^later\_than/) {
                    789:                     $newvalue=$nval+$totalsecs;
                    790:                 } else {
                    791:                     $newvalue=$nval-$totalsecs;
                    792:                 }
                    793:             }
                    794:             if ($active) {
                    795:                 &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    796:                         $uname,$udom,$csec,$recflag,$cgroup);
                    797:             }
                    798:         }
1.226     www       799:     }
                    800:     return '';
                    801: }
                    802: 
1.561     damieng   803: # Adds all given arguments to the course parameter log.
                    804: # @returns {string} - the answer to the lonnet query.
1.293     www       805: sub log_parmset {
1.525     raeburn   806:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       807: }
                    808: 
1.561     damieng   809: # Store a parameter value and type by symb, without using the parameter default actions.
                    810: # Expire related sheets.
                    811: #
1.566     damieng   812: # @param {string} $symb - resource symb or map src
1.561     damieng   813: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
                    814: # @param {integer} $snum - level
                    815: # @param {string} $nval - new value
                    816: # @param {string} $ntype - new type
                    817: # @param {string} $uname - username
                    818: # @param {string} $udom - userdomain
                    819: # @param {string} $csec - section name
                    820: # @param {string} $cgroup - group name
                    821: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226     www       822: sub storeparm_by_symb_inner {
1.197     www       823: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   824:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       825: # ---------------------------------------------------------- Construct prefixes
1.186     www       826:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    827:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  828:     $map = &Apache::lonnet::deversion($map);
                    829: 
1.197     www       830:     my $symbparm=$symb.'.'.$spnam;
1.556     raeburn   831:     my $recurseparm=$map.'___(rec).'.$spnam;
1.197     www       832:     my $mapparm=$map.'___(all).'.$spnam;
                    833: 
1.269     raeburn   834:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    835:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   836:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   837:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    838: 
1.190     albertel  839:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    840:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   841:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  842:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    843: 
1.190     albertel  844:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    845:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   846:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  847:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    848: 
1.186     www       849:     my $storeunder='';
1.578     raeburn   850:     my $possreplace='';
1.556     raeburn   851:     if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
1.578     raeburn   852:     if (($snum==17) || ($snum==3)) { 
                    853:         $storeunder=$courseleveli;
                    854:         $possreplace=$courselevelm; 
                    855:     } 
                    856:     if (($snum==16) || ($snum==2)) { 
                    857:         $storeunder=$courselevelm;
                    858:         $possreplace=$courseleveli;
                    859:     }
1.556     raeburn   860:     if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
                    861:     if ($snum==12) { $storeunder=$seclevel; }
1.578     raeburn   862:     if ($snum==11) { 
                    863:         $storeunder=$secleveli;
                    864:         $possreplace=$seclevelm; 
                    865:     }
                    866:     if ($snum==10) { 
                    867:         $storeunder=$seclevelm;
                    868:         $possreplace=$secleveli;
                    869:     }
1.556     raeburn   870:     if ($snum==9) { $storeunder=$seclevelr; }
                    871:     if ($snum==8) { $storeunder=$grplevel; }
1.578     raeburn   872:     if ($snum==7) { 
                    873:         $storeunder=$grpleveli;
                    874:         $possreplace=$grplevelm;
                    875:     }
                    876:     if ($snum==6) {
                    877:         $storeunder=$grplevelm;
                    878:         $possreplace=$grpleveli;
                    879:     }
1.556     raeburn   880:     if ($snum==5) { $storeunder=$grplevelr; }
1.269     raeburn   881: 
1.446     bisitz    882: 
1.186     www       883:     my $delete;
                    884:     if ($nval eq '') { $delete=1;}
                    885:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  886:             $storeunder.'.type' => $ntype);
1.186     www       887:     my $reply='';
1.560     damieng   888:     
1.556     raeburn   889:     if ($snum>4) {
1.186     www       890: # ---------------------------------------------------------------- Store Course
                    891: #
1.560     damieng   892:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    893:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    894:         # Expire sheets
                    895:         &Apache::lonnet::expirespread('','','studentcalc');
                    896:         if (($snum==13) || ($snum==9) || ($snum==5)) {
                    897:             &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.578     raeburn   898:         } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
1.560     damieng   899:             &Apache::lonnet::expirespread('','','assesscalc',$map);
                    900:         } else {
                    901:             &Apache::lonnet::expirespread('','','assesscalc');
                    902:         }
                    903:         # Store parameter
                    904:         if ($delete) {
                    905:             $reply=&Apache::lonnet::del
                    906:             ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
                    907:                 &log_parmset(\%storecontent,1);
                    908:         } else {
                    909:             $reply=&Apache::lonnet::cput
                    910:             ('resourcedata',\%storecontent,$cdom,$cnum);
                    911:             &log_parmset(\%storecontent);
1.578     raeburn   912:             if ($possreplace) {
                    913:                 my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
                    914:                 if (ref($resdata) eq 'HASH') {
                    915:                     if (exists($resdata->{$possreplace})) {
                    916:                         if (&Apache::lonnet::del
                    917:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
                    918:                             &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);   
                    919:                         }
                    920:                     }
                    921:                 }
                    922:             }
1.560     damieng   923:         }
                    924:         &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       925:     } else {
                    926: # ------------------------------------------------------------------ Store User
                    927: #
1.560     damieng   928:         # Expire sheets
                    929:         &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    930:         if ($snum==1) {
                    931:             &Apache::lonnet::expirespread
                    932:             ($uname,$udom,'assesscalc',$symb);
1.578     raeburn   933:         } elsif (($snum==2) || ($snum==3)) {
1.560     damieng   934:             &Apache::lonnet::expirespread
                    935:             ($uname,$udom,'assesscalc',$map);
                    936:         } else {
                    937:             &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    938:         }
                    939:         # Store parameter
                    940:         if ($delete) {
                    941:             $reply=&Apache::lonnet::del
                    942:             ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    943:             &log_parmset(\%storecontent,1,$uname,$udom);
                    944:         } else {
                    945:             $reply=&Apache::lonnet::cput
                    946:             ('resourcedata',\%storecontent,$udom,$uname);
                    947:             &log_parmset(\%storecontent,0,$uname,$udom);
1.578     raeburn   948:             if ($possreplace) {
                    949:                 my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
                    950:                 if (ref($resdata) eq 'HASH') {
                    951:                     if (exists($resdata->{$possreplace})) {
                    952:                         if (&Apache::lonnet::del
                    953:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
                    954:                             &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
                    955:                                           $uname,$udom);
                    956:                         }
                    957:                     }
                    958:                 }
                    959:             }
1.560     damieng   960:         }
                    961:         &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       962:     }
1.446     bisitz    963: 
1.186     www       964:     if ($reply=~/^error\:(.*)/) {
1.560     damieng   965:         return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       966:     }
                    967:     return '';
                    968: }
                    969: 
1.9       www       970: 
1.561     damieng   971: # Returns HTML with the value of the given parameter,
                    972: # using a readable format for dates, and
                    973: # a warning if there is a problem with a date.
                    974: # Used by table mode.
                    975: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
                    976: #
                    977: # @param {string} $value - the parameter value
                    978: # @param {string} $type - the parameter type
                    979: # @param {string} $name - the parameter name (unused)
                    980: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9       www       981: sub valout {
1.554     raeburn   982:     my ($value,$type,$name,$editable)=@_;
1.59      matthew   983:     my $result = '';
                    984:     # Values of zero are valid.
                    985:     if (! $value && $value ne '0') {
1.528     bisitz    986:         if ($editable) {
                    987:             $result =
                    988:                 '<img src="/res/adm/pages/editmap.png"'
                    989:                .' alt="'.&mt('Change').'"'
1.539     raeburn   990:                .' title="'.&mt('Change').'" style="border:0;" />';
1.528     bisitz    991:         } else {
                    992:             $result='&nbsp;';
                    993:         }
1.59      matthew   994:     } else {
1.66      www       995:         if ($type eq 'date_interval') {
1.559     raeburn   996:             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    997:             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    998:             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    999:                 $donebuttontext = $1;
                   1000:                 (undef,$proctor,$secretkey) = split(/_/,$2);
                   1001:                 $usesdone = 'done';
                   1002:             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                   1003:                 $donebuttontext = &mt('Done');
                   1004:                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                   1005:             }
1.554     raeburn  1006:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz   1007:             my @timer;
1.66      www      1008:             $year=$year-70;
                   1009:             $mday--;
                   1010:             if ($year) {
1.413     bisitz   1011: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                   1012:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www      1013:             }
                   1014:             if ($mon) {
1.413     bisitz   1015: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                   1016:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www      1017:             }
                   1018:             if ($mday) {
1.413     bisitz   1019: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                   1020:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www      1021:             }
                   1022:             if ($hour) {
1.413     bisitz   1023: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                   1024:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www      1025:             }
                   1026:             if ($min) {
1.413     bisitz   1027: #               $result.=&mt('[quant,_1,min]',$min).' ';
                   1028:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www      1029:             }
                   1030:             if ($sec) {
1.413     bisitz   1031: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                   1032:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www      1033:             }
1.413     bisitz   1034: #           $result=~s/\s+$//;
                   1035:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                   1036:                 push(@timer,&mt('[quant,_1,sec]',0));
                   1037:             }
                   1038:             $result.=join(", ",@timer);
1.559     raeburn  1039:             if ($usesdone eq 'done') {
1.558     raeburn  1040:                 if ($secretkey) {
1.559     raeburn  1041:                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);  
1.558     raeburn  1042:                 } else {
1.559     raeburn  1043:                     $result .= ' + "'.$donebuttontext.'"';
                   1044:                 }
1.554     raeburn  1045:             }
1.213     www      1046:         } elsif (&isdateparm($type)) {
1.361     albertel 1047:             $result = &Apache::lonlocal::locallocaltime($value).
1.560     damieng  1048:                 &date_sanity_info($value);
1.59      matthew  1049:         } else {
                   1050:             $result = $value;
1.517     www      1051:             $result=~s/\,/\, /gs;
1.560     damieng  1052:             $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew  1053:         }
                   1054:     }
                   1055:     return $result;
1.9       www      1056: }
                   1057: 
1.59      matthew  1058: 
1.561     damieng  1059: # Returns HTML containing a link on a parameter value, for table mode.
                   1060: # The link uses the javascript function 'pjump'.
                   1061: #
                   1062: # @param {string} $type - parameter type
                   1063: # @param {string} $dis - dialog title for editing the parameter value and type
                   1064: # @param {string} $value - parameter value
                   1065: # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
                   1066: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
                   1067: # @param {string} $call - javascript function to call to submit the form ('psub')
1.588     raeburn  1068: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
                   1069: # @param {string} $extra - optional additional information to send as tenth arg in call to javascript pjump function.
1.5       www      1070: sub plink {
1.588     raeburn  1071:     my ($type,$dis,$value,$marker,$return,$call,$recursive,$extra)=@_;
1.23      www      1072:     my $winvalue=$value;
                   1073:     unless ($winvalue) {
1.592   ! raeburn  1074:         if (&isdateparm($type) || (&is_specialstring($type))) {
1.190     albertel 1075:             $winvalue=$env{'form.recent_'.$type};
1.591     raeburn  1076:         } elsif ($type eq 'string_yesno') {
                   1077:             if ($env{'form.recent_string'} =~ /^(yes|no)$/i) {
                   1078:                 $winvalue=$env{'form.recent_string'};
                   1079:             }
1.23      www      1080:         } else {
1.190     albertel 1081:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1082:         }
                   1083:     }
1.229     www      1084:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1085:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1086:     unless (defined($winvalue)) { $winvalue=$val; }
1.554     raeburn  1087:     my $valout = &valout($value,$type,$parmname,1);
1.429     raeburn  1088:     my $unencmarker = $marker;
1.378     albertel 1089:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.588     raeburn  1090:               \$hour, \$min, \$sec, \$extra) {
1.560     damieng  1091:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1092:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1093:     }
1.429     raeburn  1094:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1095:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.588     raeburn  1096:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."','".$extra."'".');">'.
1.578     raeburn  1097:         $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
                   1098:                                               &mt('recursive').'</td></tr>' : '').'</table>';
                   1099: 
1.5       www      1100: }
                   1101: 
1.561     damieng  1102: # Javascript for table mode.
1.280     albertel 1103: sub page_js {
                   1104: 
1.81      www      1105:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1106:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1107: 
                   1108:     return(<<ENDJS);
                   1109: <script type="text/javascript">
1.454     bisitz   1110: // <![CDATA[
1.44      albertel 1111: 
1.88      matthew  1112:     $pjump_def
1.44      albertel 1113: 
                   1114:     function psub() {
1.591     raeburn  1115:         var specstring = /^string_!(yesno|any)/i;
1.44      albertel 1116:         if (document.parmform.pres_marker.value!='') {
                   1117:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1118:             var typedef=new Array();
                   1119:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1120:             if (document.parmform.pres_type.value!='') {
1.589     raeburn  1121:                 if ((typedef[0]=='date') || 
1.591     raeburn  1122:                     (specstring.test(document.parmform.pres_type.value)))  {
1.562     damieng  1123:                     eval('document.parmform.recent_'+
                   1124:                         document.parmform.pres_type.value+
                   1125:                         '.value=document.parmform.pres_value.value;');
                   1126:                 } else {
                   1127:                     eval('document.parmform.recent_'+typedef[0]+
                   1128:                         '.value=document.parmform.pres_value.value;');
                   1129:                 }
1.44      albertel 1130:             }
                   1131:             document.parmform.submit();
                   1132:         } else {
                   1133:             document.parmform.pres_value.value='';
                   1134:             document.parmform.pres_marker.value='';
                   1135:         }
                   1136:     }
                   1137: 
1.57      albertel 1138:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1139:         var options = "width=" + w + ",height=" + h + ",";
                   1140:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1141:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1142:         var newWin = window.open(url, wdwName, options);
                   1143:         newWin.focus();
                   1144:     }
1.523     raeburn  1145: 
1.454     bisitz   1146: // ]]>
1.523     raeburn  1147: 
1.44      albertel 1148: </script>
1.81      www      1149: $selscript
1.280     albertel 1150: ENDJS
                   1151: 
                   1152: }
1.507     www      1153: 
1.561     damieng  1154: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1155: # for table and overview modes.
1.523     raeburn  1156: sub showhide_js {
                   1157:     return <<"COURSECONTENTSCRIPT";
                   1158: 
                   1159: function showHide_courseContent() {
                   1160:     var parmlevValue=document.getElementById("parmlev").value;
                   1161:     if (parmlevValue == 'general') {
                   1162:         document.getElementById('mapmenu').style.display="none";
                   1163:     } else {
                   1164:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1165:             document.getElementById('mapmenu').style.display ="";
                   1166:         } else {
                   1167:             document.getElementById('mapmenu').style.display="none";
                   1168:         }
                   1169:     }
                   1170:     return;
                   1171: }
                   1172: 
                   1173: COURSECONTENTSCRIPT
                   1174: }
                   1175: 
1.561     damieng  1176: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1177: sub toggleparmtextbox_js {
                   1178:     return <<"ENDSCRIPT";
                   1179: 
                   1180: if (!document.getElementsByClassName) {
                   1181:     function getElementsByClassName(node, classname) {
                   1182:         var a = [];
                   1183:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1184:         var els = node.getElementsByTagName("*");
                   1185:         for(var i=0,j=els.length; i<j; i++)
                   1186:             if(re.test(els[i].className))a.push(els[i]);
                   1187:         return a;
                   1188:     }
                   1189: }
                   1190: 
                   1191: function showHideLenient() {
                   1192:     var lenients;
                   1193:     var setRegExp = /^set_/;
                   1194:     if (document.getElementsByClassName) {
                   1195:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1196:     } else {
                   1197:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1198:     }
                   1199:     if (lenients != 'undefined') {
                   1200:         for (var i=0; i<lenients.length; i++) {
                   1201:             if (lenients[i].checked) {
                   1202:                 if (lenients[i].value == 'weighted') {
                   1203:                     if (setRegExp.test(lenients[i].name)) {
                   1204:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1205:                         toggleParmTextbox(document.parmform,identifier);
                   1206:                     }
                   1207:                 }
                   1208:             }
                   1209:         }
                   1210:     }
                   1211:     return;
                   1212: }
                   1213: 
                   1214: function toggleParmTextbox(form,key) {
                   1215:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1216:     if (divfortext) {
                   1217:         var caller = form.elements['set_'+key];
                   1218:         if (caller.length) {
                   1219:             for (i=0; i<caller.length; i++) {
                   1220:                 if (caller[i].checked) {
                   1221:                     if (caller[i].value == 'weighted') {
                   1222:                         divfortext.style.display = 'inline';
                   1223:                     } else {
                   1224:                         divfortext.style.display = 'none';
                   1225:                     }
                   1226:                 }
                   1227:             }
                   1228:         }
                   1229:     }
                   1230:     return;
                   1231: }
                   1232: 
                   1233: ENDSCRIPT
                   1234: }
                   1235: 
1.561     damieng  1236: # Javascript function validateParms, for overview mode
1.549     raeburn  1237: sub validateparms_js {
                   1238:     return <<'ENDSCRIPT';
                   1239: 
                   1240: function validateParms() {
                   1241:     var textRegExp = /^settext_/;
                   1242:     var tailLenient = /\.lenient$/;
                   1243:     var patternRelWeight = /^\-?[\d.]+$/;
                   1244:     var patternLenientStd = /^(yes|no|default)$/;
                   1245:     var ipallowRegExp = /^setipallow_/;
                   1246:     var ipdenyRegExp = /^setipdeny_/; 
1.588     raeburn  1247:     var deeplinkRegExp = /^deeplink_(listing|scope)_/;
                   1248:     var deeplinkUrlsRegExp = /^deeplink_urls_/;
                   1249:     var deeplinkltiRegExp = /^deeplink_lti_/;
                   1250:     var deeplinkkeyRegExp = /^deeplink_key_/;
1.549     raeburn  1251:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1252:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1253:         if (document.parmform.elements.length) {
                   1254:             for (i=0; i<document.parmform.elements.length; i++) {
                   1255:                 var name=document.parmform.elements[i].name;
1.588     raeburn  1256:                 if (textRegExp.test(name)) {
1.549     raeburn  1257:                     var identifier = name.replace(textRegExp,'');
                   1258:                     if (tailLenient.test(identifier)) {
                   1259:                         if (document.parmform.elements['set_'+identifier].length) {
                   1260:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1261:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1262:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1263:                                         var relweight = document.parmform.elements[i].value;
                   1264:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1265:                                         if (!patternRelWeight.test(relweight)) {
                   1266:                                             relweight = '0.0';
                   1267:                                         }
                   1268:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1269:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1270:                                         } else {
                   1271:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1272:                                         }
                   1273:                                     }
                   1274:                                     break;
                   1275:                                 }
                   1276:                             }
                   1277:                         }
                   1278:                     }
1.588     raeburn  1279:                 } else if (ipallowRegExp.test(name)) {
                   1280:                     var identifier = name.replace(ipallowRegExp,'');
                   1281:                     var possallow = document.parmform.elements[i].value;
                   1282:                     possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1283:                     if (patternIP.test(possallow)) {
                   1284:                         if (document.parmform.elements['set_'+identifier].value) {
                   1285:                             possallow = ','+possallow;
                   1286:                         }
                   1287:                         document.parmform.elements['set_'+identifier].value += possallow;
                   1288:                     }
                   1289:                 } else if (ipdenyRegExp.test(name)) {
                   1290:                     var identifier = name.replace(ipdenyRegExp,'');
                   1291:                     var possdeny = document.parmform.elements[i].value;
                   1292:                     possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1293:                     if (patternIP.test(possdeny)) {
                   1294:                         possdeny = '!'+possdeny;
                   1295:                         if (document.parmform.elements['set_'+identifier].value) {
                   1296:                             possdeny = ','+possdeny;
                   1297:                         }
                   1298:                         document.parmform.elements['set_'+identifier].value += possdeny;
                   1299:                     }
                   1300:                 } else if (deeplinkRegExp.test(name)) {
                   1301:                     var identifier =  name.replace(deeplinkRegExp,'');
                   1302:                     var possdeeplink = document.parmform.elements[i].value;
                   1303:                     possdeeplink = possdeeplink.replace(/^\s+|\s+$/g,'');
                   1304:                     if (document.parmform.elements['set_'+identifier].value) {
                   1305:                         possdeeplink = ','+possdeeplink;
                   1306:                     }
                   1307:                     document.parmform.elements['set_'+identifier].value += possdeeplink;
                   1308:                 } else if (deeplinkUrlsRegExp.test(name)) {
                   1309:                     if (document.parmform.elements[i].checked) {
                   1310:                         var identifier =  name.replace(deeplinkUrlsRegExp,'');
                   1311:                         var posslinkurl = document.parmform.elements[i].value;
                   1312:                         posslinkurl = posslinkurl.replace(/^\s+|\s+$/g,'');
                   1313:                         if (document.parmform.elements['set_'+identifier].value) {
                   1314:                             posslinkurl = ','+posslinkurl;
                   1315:                         }
                   1316:                         document.parmform.elements['set_'+identifier].value += posslinkurl;
                   1317:                     }
                   1318:                 } else if (deeplinkltiRegExp.test(name)) {
                   1319:                     var identifier = name.replace(deeplinkltiRegExp,'');
                   1320:                     var posslti = document.parmform.elements[i].value;
                   1321:                     posslti = posslti.replace(/\D+/g,'');
                   1322:                     if (document.parmform.elements['set_'+identifier].value) {
                   1323:                         posslti = ':'+posslti;
                   1324:                     }
                   1325:                     document.parmform.elements['set_'+identifier].value += posslti;
                   1326:                 } else if (deeplinkkeyRegExp.test(name)) {
                   1327:                     var identifier = name.replace(deeplinkkeyRegExp,'');
                   1328:                     var posskey = document.parmform.elements[i].value;
                   1329:                     posskey = posskey.replace(/\W+/g,'');
                   1330:                     if (document.parmform.elements['set_'+identifier].value) {
                   1331:                         posslti = ':'+posskey;
1.549     raeburn  1332:                     }
1.588     raeburn  1333:                     document.parmform.elements['set_'+identifier].value += posskey;
1.549     raeburn  1334:                 }
                   1335:             }
                   1336:         }
                   1337:     }
                   1338:     return true;
                   1339: }
                   1340: 
                   1341: ENDSCRIPT
                   1342: }
                   1343: 
1.561     damieng  1344: # Javascript initialization, for overview mode
1.549     raeburn  1345: sub ipacc_boxes_js  {
                   1346:     my $remove = &mt('Remove');
                   1347:     return <<"END";
                   1348: \$(document).ready(function() {
                   1349:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1350:     var add_button      = \$(".LC_add_ipacc_button");
                   1351:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1352: 
                   1353:     \$(add_button).click(function(e){
                   1354:         e.preventDefault();
                   1355:         var identifier = \$(this).closest("div").attr("id");
                   1356:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1357:         \$(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  1358:     });
                   1359: 
                   1360:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1361:         e.preventDefault(); \$(this).closest("div").remove();
                   1362:     })
                   1363: });
                   1364: 
                   1365: 
                   1366: END
                   1367: }
                   1368: 
1.561     damieng  1369: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1370: sub done_proctor_js {
                   1371:     return <<"END";
                   1372: function toggleSecret(form,radio,key) {
                   1373:     var radios = form[radio+key];
                   1374:     if (radios.length) {
                   1375:         for (var i=0; i<radios.length; i++) {
                   1376:             if (radios[i].checked) {
                   1377:                 if (radios[i].value == '_done_proctor') {
                   1378:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1379:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1380:                     }
                   1381:                 } else {
                   1382:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1383:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1384:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1385:                     }
                   1386:                 }
                   1387:             }
                   1388:         }
                   1389:     }
                   1390: }
                   1391: END
                   1392: 
                   1393: }
                   1394: 
1.588     raeburn  1395: # Javascript function toggle
                   1396: sub deeplink_js {
                   1397:     return <<"END";
                   1398: function toggleDeepLink(form,item,key) {
                   1399:     var radios = form['deeplink_'+item+'_'+key];
                   1400:     if (radios.length) {
                   1401:         var keybox;
                   1402:         if (document.getElementById('deeplink_key_'+item+'_'+key)) {
                   1403:             keybox = document.getElementById('deeplink_key_'+item+'_'+key);
                   1404:         }
                   1405:         var ltidiv;
                   1406:         if (document.getElementById('deeplinkdiv_lti_'+item+'_'+key)) {
                   1407:             ltidiv = document.getElementById('deeplinkdiv_lti_'+item+'_'+key);
                   1408:         }
                   1409:         for (var i=0; i<radios.length; i++) {
                   1410:             if (radios[i].checked) {
                   1411:                 if (radios[i].value == 'lti') {
                   1412:                     ltidiv.style.display = 'inline-block';
                   1413:                     keybox.type = 'hidden';
                   1414:                     keybox.value = '';
                   1415:                 } else {
                   1416:                     if (ltidiv != '') {
                   1417:                         ltidiv.style.display = 'none';
                   1418:                         form['deeplink_lti_'+key].selectedIndex = 0;
                   1419:                     }
                   1420:                     if (radios[i].value == 'key') {
                   1421:                         keybox.type = 'text';
                   1422:                     } else {
                   1423:                         keybox.type = 'hidden';
                   1424:                     }
                   1425:                 }
                   1426:             }
                   1427:         }
                   1428:     }
                   1429: }
                   1430: END
                   1431: 
                   1432: }
                   1433: 
1.561     damieng  1434: # Prints HTML page start for table mode.
                   1435: # @param {Apache2::RequestRec} $r - the Apache request
                   1436: # @param {string} $psymb - resource symb
                   1437: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1438: sub startpage {
1.531     raeburn  1439:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1440: 
1.515     raeburn  1441:     my %loaditems = (
                   1442:                       'onload'   => "group_or_section('cgroup')",
                   1443:                     );
                   1444:     if (!$psymb) {
1.523     raeburn  1445:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1446:     }
1.280     albertel 1447: 
1.560     damieng  1448:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1449:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1450:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1451:             text=>"Problem Parameters"});
1.414     droeschl 1452:     } else {
1.560     damieng  1453:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1454:             text=>"Table Mode",
                   1455:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1456:     }
1.523     raeburn  1457:     my $js = &page_js().'
                   1458: <script type="text/javascript">
                   1459: // <![CDATA[
                   1460: '.
                   1461:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1462: // ]]>
                   1463: </script>
                   1464: ';
1.446     bisitz   1465:     my $start_page =
1.523     raeburn  1466:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1467:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1468:     my $breadcrumbs =
1.473     amueller 1469:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1470:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1471:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1472:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1473:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1474:     $r->print(<<ENDHEAD);
1.193     albertel 1475: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1476: <input type="hidden" value="" name="pres_value" />
                   1477: <input type="hidden" value="" name="pres_type" />
                   1478: <input type="hidden" value="" name="pres_marker" />
                   1479: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1480: <input type="hidden" value="$escfilter" name="filter" />
                   1481: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1482: ENDHEAD
                   1483: }
                   1484: 
1.209     www      1485: 
1.561     damieng  1486: # Prints a row for table mode (except for the tr start).
                   1487: # Every time a hash reference is passed, a single entry is used, so print_row
                   1488: # could just use these values, but why make it simple when it can be complicated ?
                   1489: #
                   1490: # @param {Apache2::RequestRec} $r - the Apache request
                   1491: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1492: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1493: # @param {hash reference} $name - parameter key -> parameter name
1.566     damieng  1494: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561     damieng  1495: # @param {string} $rid - resource id
                   1496: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1497: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1498: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1499: # @param {string} $defbgone - user level and other levels background color
                   1500: # @param {string} $defbgtwo - section level background color, also used for part number
                   1501: # @param {string} $defbgthree - group level background color
                   1502: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1503: # @param {string} $uname - user name
                   1504: # @param {string} $udom - user domain
                   1505: # @param {string} $csec - section name
                   1506: # @param {string} $cgroup - group name
                   1507: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1508: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.582     raeburn  1509: # @param {boolean} $readonly - true if no editing allowed.
                   1510: # @param {array reference} - $recurseup - list of maps containing current one, ending at top-level.
                   1511: # @param {hash reference} - $maptitles - - hash map id or src -> map title 
                   1512: # @param {hash reference} - $allmaps_inverted - hash map src -> map pc
                   1513: # @param {scalar reference} - $reclinks - number of "parameter in effect" cells with link to map where recursive param was set 
1.44      albertel 1514: sub print_row {
1.201     www      1515:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568     raeburn  1516:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
1.582     raeburn  1517:     $readonly,$recurseup,$maptitles,$allmaps_inverted,$reclinks)=@_;
1.275     raeburn  1518:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1519:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1520:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.582     raeburn  1521:     my $numlinks = 0;
1.553     raeburn  1522: 
1.560     damieng  1523:     # get the values for the parameter in cascading order
                   1524:     # empty levels will remain empty
1.44      albertel 1525:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1526:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1527:     # get the type for the parameters
                   1528:     # problem: these may not be set for all levels
1.66      www      1529:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1530:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1531:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1532:     # cascade down manually
1.182     albertel 1533:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1534:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1535:         if ($typeoutpar[$i]) {
1.66      www      1536:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1537:         } else {
1.66      www      1538:             $typeoutpar[$i]=$cascadetype;
                   1539:         }
                   1540:     }
1.57      albertel 1541:     my $parm=$$display{$which};
                   1542: 
1.203     www      1543:     if ($parmlev eq 'full') {
1.419     bisitz   1544:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1545:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1546:     } else {
1.57      albertel 1547:         $parm=~s|\[.*\]\s||g;
                   1548:     }
1.231     www      1549:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1550:     if ($automatic) {
1.560     damieng  1551:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1552:     }
1.427     bisitz   1553:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1554: 
1.44      albertel 1555:     my $thismarker=$which;
                   1556:     $thismarker=~s/^parameter\_//;
                   1557:     my $mprefix=$rid.'&'.$thismarker.'&';
1.582     raeburn  1558:     my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1559:     my ($othergrp,$grp_parm,$controlgrp,$effective_parm,$effparm_rec,$effparm_level,
1.588     raeburn  1560:         $eff_groupparm,$recurse_check,$recursinfo,$extra);
1.582     raeburn  1561:     if ((ref($recurseup) eq 'ARRAY') && (@{$recurseup} > 0)) {
                   1562:         if ($result eq '') {
                   1563:             $recurse_check = 1;
                   1564:         } elsif (($uname ne '') && ($result > 3)) {
                   1565:             $recurse_check = 1;
                   1566:         } elsif (($cgroup ne '') && ($result > 7)) {
                   1567:             $recurse_check = 1;
                   1568:         } elsif (($csec ne '') && ($result > 11)) {
                   1569:             $recurse_check = 1;
                   1570:         } elsif ($result > 17) {
                   1571:             $recurse_check = 1;
                   1572:         }
                   1573:         if ($recurse_check) {
                   1574:             my $what = $$part{$which}.'.'.$$name{$which};
                   1575:             my $prefix;
                   1576:             if (($uname ne '') && ($udom ne '')) {
                   1577:                 my $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
                   1578:                 $prefix = $env{'request.course.id'};
                   1579:                 $recursinfo = &get_recursive($recurseup,$useropt,$what,$prefix);
                   1580:                 if (ref($recursinfo) eq 'ARRAY') {
                   1581:                     $effparm_rec = 1;
                   1582:                     $effparm_level = &mt('user: [_1]',$uname);
                   1583:                 }
                   1584:             }
                   1585:             if (($cgroup ne '') && (!$effparm_rec)) {
                   1586:                 $prefix = $env{'request.course.id'}.'.['.$cgroup.']';
                   1587:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1588:                 if (ref($recursinfo) eq 'ARRAY') {
                   1589:                     $effparm_rec = 1;
                   1590:                     $effparm_level = &mt('group: [_1]',$cgroup);
                   1591:                 }
                   1592:             }
                   1593:             if (($csec ne '') && (!$effparm_rec)) {
                   1594:                 $prefix = $env{'request.course.id'}.'.['.$csec.']';
                   1595:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1596:                 if (ref($recursinfo) eq 'ARRAY') {
                   1597:                     $effparm_rec = 1;
                   1598:                     $effparm_level = &mt('section: [_1]',$csec);
                   1599:                 }
                   1600:             }
                   1601:             if (!$effparm_rec) {
                   1602:                 $prefix = $env{'request.course.id'};
                   1603:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix); 
                   1604:                 if (ref($recursinfo) eq 'ARRAY') {
                   1605:                     $effparm_rec = 1;
                   1606:                 }
                   1607:             }
                   1608:         }
                   1609:     }
                   1610:     if ((!$effparm_rec) && ($result == 17 || $result == 11 || $result == 7 || $result == 3)) {
                   1611:         $effparm_rec = 1;
                   1612:     }
                   1613:     if ((!$effparm_rec) && 
                   1614:         (($$name{$which} eq 'encrypturl') || ($$name{$which} eq 'hiddenresource')) && 
                   1615:         ($result == 16 || $result == 10 || $result == 6 || $result == 2)) {
1.578     raeburn  1616:         $effparm_rec = 1;
                   1617:     }
1.588     raeburn  1618:     if ($parmname eq 'deeplink') {
                   1619:         my %posslti;
                   1620:         my %lti =
                   1621:             &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   1622:                                             'provider');
                   1623:         foreach my $item (keys(%lti)) {
                   1624:             if (ref($lti{$item}) eq 'HASH') {
                   1625:                 unless ($lti{$item}{'requser'}) {
                   1626:                     $posslti{$item} = $lti{$item}{'consumer'};
                   1627:                 }
                   1628:             }
                   1629:         }
                   1630:         if (keys(%posslti)) {
                   1631:             $extra = 'lti_';
                   1632:             foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   1633:                 $extra .= $lti.':'.&js_escape($posslti{$lti}).',';
                   1634:             }
                   1635:             $extra =~ s/,$//;
                   1636:         }
                   1637:     }
1.57      albertel 1638:     if ($parmlev eq 'general') {
                   1639:         if ($uname) {
1.588     raeburn  1640:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.269     raeburn  1641:         } elsif ($cgroup) {
1.588     raeburn  1642:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
1.57      albertel 1643:         } elsif ($csec) {
1.588     raeburn  1644:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1645:         } else {
1.588     raeburn  1646:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1647:         }
                   1648:     } elsif ($parmlev eq 'map') {
                   1649:         if ($uname) {
1.588     raeburn  1650:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.269     raeburn  1651:         } elsif ($cgroup) {
1.588     raeburn  1652:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
1.57      albertel 1653:         } elsif ($csec) {
1.588     raeburn  1654:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1655:         } else {
1.588     raeburn  1656:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1657:         }
                   1658:     } else {
1.275     raeburn  1659:         if ($uname) {
                   1660:             if (@{$usersgroups} > 1) {
1.582     raeburn  1661:                 (my $coursereply,$othergrp,$grp_parm,$controlgrp,my $grp_is_rec) =
1.580     raeburn  1662:                     &check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1663:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.582     raeburn  1664:                 if (($coursereply) && ($result > 4)) {
1.275     raeburn  1665:                     if (defined($controlgrp)) {
                   1666:                         if ($cgroup ne $controlgrp) {
1.582     raeburn  1667:                             $eff_groupparm = $grp_parm;
                   1668:                             undef($result);
                   1669:                             undef($effparm_rec);
                   1670:                             if ($grp_is_rec) {
                   1671:                                  $effparm_rec = 1;
                   1672:                             }
1.275     raeburn  1673:                         }
                   1674:                     }
                   1675:                 }
                   1676:             }
                   1677:         }
1.57      albertel 1678: 
1.588     raeburn  1679:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1680:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1681:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1682:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1683:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1684: 
                   1685:         if ($csec) {
1.588     raeburn  1686:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1687:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1688:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1689:         }
1.269     raeburn  1690: 
                   1691:         if ($cgroup) {
1.588     raeburn  1692:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
                   1693:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
                   1694:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly,'',$extra);
1.269     raeburn  1695:         }
1.446     bisitz   1696: 
1.548     raeburn  1697:         if ($uname) {
1.275     raeburn  1698:             if ($othergrp) {
                   1699:                 $r->print($othergrp);
                   1700:             }
1.588     raeburn  1701:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1702:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1703:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1704:         }
1.57      albertel 1705:     } # end of $parmlev if/else
1.582     raeburn  1706:     if (ref($recursinfo) eq 'ARRAY') {
                   1707:         my $rectitle = &mt('recursive');
                   1708:         if ((ref($maptitles) eq 'HASH') && (exists($maptitles->{$recursinfo->[2]}))) {
                   1709:             if ((ref($allmaps_inverted) eq 'HASH') && (exists($allmaps_inverted->{$recursinfo->[2]}))) {
                   1710:                 $rectitle = &mt('set in: [_1]','"'.
                   1711:                                 '<a href="javascript:pjumprec('."'".$allmaps_inverted->{$recursinfo->[2]}."',".
                   1712:                                                               "'$parmname','$$part{$which}'".');">'.
                   1713:                                 $maptitles->{$recursinfo->[2]}.'</a>"');
                   1714:               
                   1715:                 $numlinks ++;
                   1716:             }
                   1717:         }
                   1718:         my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1719:         $effective_parm = &valout($recursinfo->[0],$recursinfo->[1],$parmname);
                   1720:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1721:                   '<br /><span class="LC_parm_recursive">'.$rectitle.'&nbsp;'.
                   1722:                   $effparm_level.'</span></td>');
                   1723:     } else {
                   1724:         if ($result) {
                   1725:             $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$parmname);
                   1726:         }
                   1727:         if ($eff_groupparm) {
                   1728:             $effective_parm = $eff_groupparm;
                   1729:         }
                   1730:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1731:                   ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
                   1732:                                 '</span>':'').'</td>');
                   1733:     }
1.203     www      1734:     if ($parmlev eq 'full') {
1.136     albertel 1735:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1736:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1737:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1738:         if (!defined($sessionvaltype)) {
                   1739:             $sessionvaltype=$$defaulttype{$which};
                   1740:         }
1.419     bisitz   1741:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.554     raeburn  1742:                   &valout($sessionval,$sessionvaltype,$$name{$which}).'&nbsp;'.
1.57      albertel 1743:                   '</font></td>');
1.136     albertel 1744:     }
1.44      albertel 1745:     $r->print('</tr>');
1.57      albertel 1746:     $r->print("\n");
1.582     raeburn  1747:     if (($numlinks) && (ref($reclinks))) {
                   1748:         $$reclinks = $numlinks;
                   1749:     }
1.44      albertel 1750: }
1.59      matthew  1751: 
1.561     damieng  1752: # Prints a cell for table mode.
                   1753: #
                   1754: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1755: # Also, it would make more sense to pass the display for this cell rather
                   1756: # than the full display hash and the key to use.
                   1757: #
                   1758: # @param {Apache2::RequestRec} $r - the Apache request
                   1759: # @param {integer} $which - level
                   1760: # @param {string} $defbg - cell background color
                   1761: # @param {integer} $result - the most specific level that is defined for that parameter
                   1762: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1763: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1764: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1765: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1766: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1767: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1768: # @param {boolean} $readonly -true if editing not allowed.
1.588     raeburn  1769: # @param {boolean} $ismaplevel - true if level is for a map.
                   1770: # @param {strring} $extra - extra informatio to pass to plink.
1.44      albertel 1771: sub print_td {
1.578     raeburn  1772:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
1.588     raeburn  1773:         $noeditgrp,$readonly,$ismaplevel,$extra)=@_;
1.578     raeburn  1774:     my ($ineffect,$recursive,$currval,$currtype,$currlevel);
                   1775:     $ineffect = 0;
                   1776:     $currval = $$outpar[$which];
                   1777:     $currtype = $$typeoutpar[$which];
                   1778:     $currlevel = $which;
                   1779:     if (($result) && ($result == $which)) {
                   1780:         $ineffect = 1;
                   1781:     } 
                   1782:     if ($ismaplevel) {
                   1783:         if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
                   1784:             if (($result) && ($result == $which)) {
                   1785:                 $recursive = 1;
                   1786:             }
                   1787:         } elsif ($$outpar[$which+1] ne '') {
                   1788:             $recursive = 1;
                   1789:             $currlevel = $which+1;
                   1790:             $currval = $$outpar[$currlevel];
                   1791:             $currtype = $$typeoutpar[$currlevel];
                   1792:             if (($result) && ($result == $currlevel)) {
                   1793:                 $ineffect = 1;
                   1794:             }
                   1795:         }
                   1796:     }
                   1797:     $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419     bisitz   1798:               ';" align="center">');
1.437     raeburn  1799:     my $nolink = 0;
1.568     raeburn  1800:     if ($readonly) {
1.552     raeburn  1801:         $nolink = 1;
1.568     raeburn  1802:     } else { 
1.578     raeburn  1803:         if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553     raeburn  1804:             $nolink = 1;
1.568     raeburn  1805:         } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533     raeburn  1806:             $nolink = 1;
1.568     raeburn  1807:         } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
                   1808:             if ($noeditgrp) {
                   1809:                 $nolink = 1;
                   1810:             }
                   1811:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1812:             if ($which > 4) {
                   1813:                 $nolink = 1;
                   1814:             }
                   1815:         } elsif ($mprefix =~ /examcode\&$/) {
                   1816:             unless ($which == 2) {
                   1817:                 $nolink = 1;
                   1818:             }
1.533     raeburn  1819:         }
1.437     raeburn  1820:     }
                   1821:     if ($nolink) {
1.577     raeburn  1822:         my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.578     raeburn  1823:         $r->print(&valout($currval,$currtype,$parmname));
1.114     www      1824:     } else {
1.578     raeburn  1825:         $r->print(&plink($currtype,
                   1826:                          $$display{$value},$currval,
1.588     raeburn  1827:                          $mprefix.$currlevel,'parmform.pres','psub',$recursive,
                   1828:                          $extra));
1.114     www      1829:     }
                   1830:     $r->print('</td>'."\n");
1.57      albertel 1831: }
                   1832: 
1.561     damieng  1833: # Returns HTML and other info for the cell added when a user is selected
                   1834: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1835: #
                   1836: # @param {string} $what - parameter part.'.'.parameter name
                   1837: # @param {string} $rid - resource id
                   1838: # @param {string} $cgroup - group name
                   1839: # @param {string} $defbg - cell background color
                   1840: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1841: # @param {integer} $result - level
                   1842: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
1.582     raeburn  1843: # @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  1844: sub check_other_groups {
                   1845:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1846:     my $courseid = $env{'request.course.id'};
                   1847:     my $output;
                   1848:     my $symb = &symbcache($rid);
                   1849:     my $symbparm=$symb.'.'.$what;
                   1850:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1851:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1852:     my $mapparm=$map.'___(all).'.$what;
                   1853:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1854:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1855:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1856:     my $bgcolor = $defbg;
1.582     raeburn  1857:     my ($grp_parm,$grp_is_rec);
1.446     bisitz   1858:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.582     raeburn  1859:         my ($parmname) = ($what =~ /\.([^.]+)$/);
1.275     raeburn  1860:         if ($result > 3) {
1.419     bisitz   1861:             $bgcolor = '#AAFFAA';
1.275     raeburn  1862:         }
1.582     raeburn  1863:         $grp_parm = &valout($coursereply,$resulttype,$parmname);
1.419     bisitz   1864:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1865:         if ($resultgroup && $resultlevel) {
1.582     raeburn  1866:             if ($resultlevel eq 'recursive') {
                   1867:                 $resultlevel = 'map/folder';
                   1868:                 $grp_is_rec = 1;
                   1869:             }
                   1870:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm.
                   1871:                        ($grp_is_rec?'<span class="LC_parm_recursive">'.&mt('recursive').'</span>':'');
                   1872:              
1.275     raeburn  1873:         } else {
                   1874:             $output .= '&nbsp;';
                   1875:         }
                   1876:         $output .= '</td>';
                   1877:     } else {
1.419     bisitz   1878:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1879:     }
1.582     raeburn  1880:     return ($coursereply,$output,$grp_parm,$resultgroup,$grp_is_rec);
1.275     raeburn  1881: }
                   1882: 
1.561     damieng  1883: # Looks for a group with a defined parameter for given user and parameter.
1.580     raeburn  1884: # Used by check_other_groups.
1.561     damieng  1885: #
                   1886: # @param {string} $courseid - the course id
                   1887: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1888: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1889: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1890: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1891: # @param {string} $what - parameter part.'.'.parameter name
                   1892: # @param {hash reference} $courseopt - course parameters hash
                   1893: # @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  1894: sub parm_control_group {
1.556     raeburn  1895:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1896:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1897:     my $grpfound = 0;
1.556     raeburn  1898:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1899:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1900:     foreach my $group (@{$usersgroups}) {
                   1901:         if ($grpfound) { last; }
                   1902:         for (my $i=0; $i<@levels; $i++) {
                   1903:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1904:             if (defined($$courseopt{$item})) {
                   1905:                 $coursereply = $$courseopt{$item};
                   1906:                 $resultitem = $item;
                   1907:                 $resultgroup = $group;
                   1908:                 $resultlevel = $levelnames[$i];
                   1909:                 $resulttype = $$courseopt{$item.'.type'};
                   1910:                 $grpfound = 1;
                   1911:                 last;
                   1912:             }
                   1913:         }
                   1914:     }
                   1915:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1916: }
1.201     www      1917: 
1.63      bowersj2 1918: 
                   1919: 
1.562     damieng  1920: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1921: # All the parameters are references and are filled by the sub.
                   1922: #
1.566     damieng  1923: # @param {array reference} $ids - resource and map ids
                   1924: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
                   1925: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562     damieng  1926: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1927: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566     damieng  1928: # @param {hash reference} $allmaps - hash map pc -> map src
                   1929: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
                   1930: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
                   1931: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
                   1932: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562     damieng  1933: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1934: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1935: sub extractResourceInformation {
                   1936:     my $ids = shift;
                   1937:     my $typep = shift;
                   1938:     my $keyp = shift;
                   1939:     my $allparms = shift;
                   1940:     my $allparts = shift;
                   1941:     my $allmaps = shift;
                   1942:     my $mapp = shift;
                   1943:     my $symbp = shift;
1.82      www      1944:     my $maptitles=shift;
1.196     www      1945:     my $uris=shift;
1.210     www      1946:     my $keyorder=shift;
1.211     www      1947:     my $defkeytype=shift;
1.196     www      1948: 
1.210     www      1949:     my $keyordercnt=100;
1.63      bowersj2 1950: 
1.196     www      1951:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1952:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1953:     foreach my $resource (@allres) {
1.480     amueller 1954:         my $id=$resource->id();
1.196     www      1955:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1956:         if ($mapid eq '0') { next; }
                   1957:         $$ids[$#$ids+1]=$id;
                   1958:         my $srcf=$resource->src();
                   1959:         $srcf=~/\.(\w+)$/;
                   1960:         $$typep{$id}=$1;
1.584     raeburn  1961:         my $toolsymb;
                   1962:         if ($srcf =~ /ext\.tool$/) {
                   1963:             $toolsymb = $resource->symb();
                   1964:         }
1.480     amueller 1965:         $$keyp{$id}='';
1.196     www      1966:         $$uris{$id}=$srcf;
1.512     foxr     1967: 
1.584     raeburn  1968:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys',$toolsymb))) {
1.480     amueller 1969:             next if ($key!~/^parameter_/);
1.363     albertel 1970: 
1.209     www      1971: # Hidden parameters
1.584     raeburn  1972:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden',$toolsymb) eq 'parm');
1.209     www      1973: #
                   1974: # allparms is a hash of parameter names
                   1975: #
1.584     raeburn  1976:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name',$toolsymb);
1.480     amueller 1977:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1978:                 my ($display,$parmdis);
                   1979:                 $display = &standard_parameter_names($name);
                   1980:                 if ($display eq '') {
1.584     raeburn  1981:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display',$toolsymb);
1.480     amueller 1982:                     $parmdis = $display;
                   1983:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1984:                 } else {
                   1985:                     $parmdis = &mt($display);
                   1986:                 }
                   1987:                 $$allparms{$name}=$parmdis;
                   1988:                 if (ref($defkeytype)) {
                   1989:                     $$defkeytype{$name}=
1.584     raeburn  1990:                     &Apache::lonnet::metadata($srcf,$key.'.type',$toolsymb);
1.480     amueller 1991:                 }
                   1992:             }
1.363     albertel 1993: 
1.209     www      1994: #
                   1995: # allparts is a hash of all parts
                   1996: #
1.584     raeburn  1997:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part',$toolsymb);
1.480     amueller 1998:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1999: #
                   2000: # Remember all keys going with this resource
                   2001: #
1.480     amueller 2002:             if ($$keyp{$id}) {
                   2003:                 $$keyp{$id}.=','.$key;
                   2004:             } else {
                   2005:                 $$keyp{$id}=$key;
                   2006:             }   
1.210     www      2007: #
                   2008: # Put in order
1.446     bisitz   2009: #
1.480     amueller 2010:             unless ($$keyorder{$key}) {
                   2011:                 $$keyorder{$key}=$keyordercnt;
                   2012:                 $keyordercnt++;
                   2013:             }
1.473     amueller 2014:         }
                   2015: 
                   2016: 
1.480     amueller 2017:         if (!exists($$mapp{$mapid})) {
                   2018:             $$mapp{$id}=
                   2019:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   2020:             $$mapp{$mapid}=$$mapp{$id};
                   2021:             $$allmaps{$mapid}=$$mapp{$id};
                   2022:             if ($mapid eq '1') {
1.532     raeburn  2023:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 2024:             } else {
                   2025:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   2026:             }
                   2027:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  2028:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   2029:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   2030:                                                      # are commented out in rev. 1.57
1.473     amueller 2031:         } else {
1.480     amueller 2032:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 2033:         }
1.480     amueller 2034:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 2035:     }
                   2036: }
                   2037: 
1.582     raeburn  2038: sub get_recursive {
                   2039:     my ($recurseup,$resdata,$what,$prefix) = @_; 
                   2040:     if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
                   2041:         foreach my $item (@{$recurseup}) {
                   2042:             my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
                   2043:             if (defined($resdata->{$norecursechk})) {
                   2044:                 if ($what =~ /\.(encrypturl|hiddenresource)$/) {
                   2045:                     my $type = $resdata->{$norecursechk.'.type'};
                   2046:                     return [$resdata->{$norecursechk},$type,$item];
                   2047:                 } else {
                   2048:                     last;
                   2049:                 }
                   2050:             }
                   2051:             my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
                   2052:             if (defined($resdata->{$recursechk})) {
                   2053:                 my $type = $resdata->{$recursechk.'.type'};
                   2054:                 return [$resdata->{$recursechk},$type,$item];
                   2055:             }
                   2056:         }
                   2057:     }
                   2058:     return;
                   2059: }
                   2060: 
1.208     www      2061: 
1.562     damieng  2062: # Tells if a parameter type is a date.
                   2063: #
                   2064: # @param {string} type - parameter type
                   2065: # @returns{boolean} - true if it is a date
1.213     www      2066: sub isdateparm {
                   2067:     my $type=shift;
                   2068:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   2069: }
                   2070: 
1.589     raeburn  2071: # Determine if parameter type is specialized string type (i.e.,
                   2072: # not just string or string_yesno.  
                   2073: 
                   2074: sub is_specialstring {
                   2075:     my $type=shift;
1.590     raeburn  2076:     return (($type=~/^string_/) && (($type ne 'string_yesno')));
1.589     raeburn  2077: }
                   2078: 
1.562     damieng  2079: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 2080: #
1.581     raeburn  2081: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      2082: sub parmmenu {
1.581     raeburn  2083:     my ($r)=@_;
1.208     www      2084:     $r->print(<<ENDSCRIPT);
                   2085: <script type="text/javascript">
1.454     bisitz   2086: // <![CDATA[
1.208     www      2087:     function checkall(value, checkName) {
1.453     schualex 2088: 
                   2089:         var li = "_li";
                   2090:         var displayOverview = "";
                   2091:         
                   2092:         if (value == false) {
                   2093:             displayOverview = "none"
                   2094:         }
                   2095: 
1.562     damieng  2096:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      2097:             ele = document.forms.parmform.elements[i];
                   2098:             if (ele.name == checkName) {
                   2099:                 document.forms.parmform.elements[i].checked=value;
                   2100:             }
                   2101:         }
                   2102:     }
1.210     www      2103: 
                   2104:     function checkthis(thisvalue, checkName) {
1.562     damieng  2105:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      2106:             ele = document.forms.parmform.elements[i];
                   2107:             if (ele.name == checkName) {
1.562     damieng  2108:                 if (ele.value == thisvalue) {
                   2109:                     document.forms.parmform.elements[i].checked=true;
                   2110:                 }
1.210     www      2111:             }
                   2112:         }
                   2113:     }
                   2114: 
                   2115:     function checkdates() {
1.562     damieng  2116:         checkthis('duedate','pscat');
                   2117:         checkthis('opendate','pscat');
                   2118:         checkthis('answerdate','pscat');
1.218     www      2119:     }
                   2120: 
                   2121:     function checkdisset() {
1.562     damieng  2122:         checkthis('discussend','pscat');
                   2123:         checkthis('discusshide','pscat');
                   2124:         checkthis('discussvote','pscat');
1.218     www      2125:     }
                   2126: 
                   2127:     function checkcontdates() {
1.562     damieng  2128:         checkthis('contentopen','pscat');
                   2129:         checkthis('contentclose','pscat');
1.218     www      2130:     }
1.446     bisitz   2131: 
1.210     www      2132:     function checkvisi() {
1.562     damieng  2133:         checkthis('hiddenresource','pscat');
                   2134:         checkthis('encrypturl','pscat');
                   2135:         checkthis('problemstatus','pscat');
                   2136:         checkthis('contentopen','pscat');
                   2137:         checkthis('opendate','pscat');
1.210     www      2138:     }
                   2139: 
                   2140:     function checkparts() {
1.562     damieng  2141:         checkthis('hiddenparts','pscat');
                   2142:         checkthis('display','pscat');
                   2143:         checkthis('ordered','pscat');
1.210     www      2144:     }
                   2145: 
                   2146:     function checkstandard() {
                   2147:         checkall(false,'pscat');
1.562     damieng  2148:         checkdates();
                   2149:         checkthis('weight','pscat');
                   2150:         checkthis('maxtries','pscat');
                   2151:         checkthis('type','pscat');
                   2152:         checkthis('problemstatus','pscat');
1.210     www      2153:     }
                   2154: 
1.454     bisitz   2155: // ]]>
1.208     www      2156: </script>
                   2157: ENDSCRIPT
1.453     schualex 2158: 
1.491     bisitz   2159:     $r->print('<hr />');
1.581     raeburn  2160:     &shortCuts($r);
1.491     bisitz   2161:     $r->print('<hr />');
1.453     schualex 2162: }
1.562     damieng  2163: 
                   2164: # Returns parameter categories.
                   2165: #
                   2166: # @returns {hash} - category name -> title in English
1.465     amueller 2167: sub categories {
                   2168:     return ('time_settings' => 'Time Settings',
                   2169:     'grading' => 'Grading',
                   2170:     'tries' => 'Tries',
                   2171:     'problem_appearance' => 'Problem Appearance',
                   2172:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   2173:     'hiding' => 'Hiding',
                   2174:     'high_level_randomization' => 'High Level Randomization',
                   2175:     'slots' => 'Slots',
                   2176:     'file_submission' => 'File Submission',
                   2177:     'misc' => 'Miscellaneous' ); 
                   2178: }
                   2179: 
1.562     damieng  2180: # Returns the category for each parameter.
                   2181: #
                   2182: # @returns {hash} - parameter name -> category name
1.465     amueller 2183: sub lookUpTableParameter {
                   2184:  
                   2185:     return ( 
                   2186:         'opendate' => 'time_settings',
                   2187:         'duedate' => 'time_settings',
                   2188:         'answerdate' => 'time_settings',
                   2189:         'interval' => 'time_settings',
                   2190:         'contentopen' => 'time_settings',
                   2191:         'contentclose' => 'time_settings',
                   2192:         'discussend' => 'time_settings',
1.560     damieng  2193:         'printstartdate' => 'time_settings',
                   2194:         'printenddate' => 'time_settings',
1.465     amueller 2195:         'weight' => 'grading',
                   2196:         'handgrade' => 'grading',
                   2197:         'maxtries' => 'tries',
                   2198:         'hinttries' => 'tries',
1.503     raeburn  2199:         'randomizeontries' => 'tries',
1.465     amueller 2200:         'type' => 'problem_appearance',
                   2201:         'problemstatus' => 'problem_appearance',
                   2202:         'display' => 'problem_appearance',
                   2203:         'ordered' => 'problem_appearance',
                   2204:         'numbubbles' => 'problem_appearance',
                   2205:         'tol' => 'behaviour_of_input_fields',
                   2206:         'sig' => 'behaviour_of_input_fields',
                   2207:         'turnoffunit' => 'behaviour_of_input_fields',
                   2208:         'hiddenresource' => 'hiding',
                   2209:         'hiddenparts' => 'hiding',
                   2210:         'discusshide' => 'hiding',
                   2211:         'buttonshide' => 'hiding',
                   2212:         'turnoffeditor' => 'hiding',
                   2213:         'encrypturl' => 'hiding',
1.587     raeburn  2214:         'deeplink' => 'hiding',
1.465     amueller 2215:         'randomorder' => 'high_level_randomization',
                   2216:         'randompick' => 'high_level_randomization',
                   2217:         'available' => 'slots',
                   2218:         'useslots' => 'slots',
                   2219:         'availablestudent' => 'slots',
                   2220:         'uploadedfiletypes' => 'file_submission',
                   2221:         'maxfilesize' => 'file_submission',
                   2222:         'cssfile' => 'misc',
                   2223:         'mapalias' => 'misc',
                   2224:         'acc' => 'misc',
                   2225:         'maxcollaborators' => 'misc',
                   2226:         'scoreformat' => 'misc',
1.514     raeburn  2227:         'lenient' => 'grading',
1.519     raeburn  2228:         'retrypartial' => 'tries',
1.521     raeburn  2229:         'discussvote'  => 'misc',
1.584     raeburn  2230:         'examcode' => 'high_level_randomization',
1.575     raeburn  2231:     );
1.465     amueller 2232: }
                   2233: 
1.562     damieng  2234: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2235: #
                   2236: # @param {string} $name - parameter name
                   2237: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2238: sub whatIsMyCategory {
                   2239:     my $name = shift;
                   2240:     my $catList = shift;
                   2241:     my @list;
                   2242:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2243:     my $cat = $lookUpList{$name};
                   2244:     if (defined($cat)) {
                   2245:         if (!defined($$catList{$cat})){
                   2246:             push @list, ($name);
                   2247:             $$catList{$cat} = \@list;
                   2248:         } else {
                   2249:             push @{${$catList}{$cat}}, ($name);     
                   2250:         }
                   2251:     } else {
                   2252:         if (!defined($$catList{'misc'})){
                   2253:             push @list, ($name);
                   2254:             $$catList{'misc'} = \@list;
                   2255:         } else {
                   2256:             push @{${$catList}{'misc'}}, ($name);     
                   2257:         }
                   2258:     }        
                   2259: }
                   2260: 
1.562     damieng  2261: # Sorts parameter names based on appearance order.
                   2262: #
                   2263: # @param {array reference} name - array reference of parameter names
                   2264: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2265: # @returns {Array} - array of parameter names
1.465     amueller 2266: sub keysindisplayorderCategory {
                   2267:     my ($name,$keyorder)=@_;
                   2268:     return sort {
1.473     amueller 2269:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2270:     } ( @{$name});
                   2271: }
                   2272: 
1.562     damieng  2273: # Returns a hash category name -> order, starting at 1 (integer)
                   2274: #
                   2275: # @returns {hash}
1.467     amueller 2276: sub category_order {
                   2277:     return (
                   2278:         'time_settings' => 1,
                   2279:         'grading' => 2,
                   2280:         'tries' => 3,
                   2281:         'problem_appearance' => 4,
                   2282:         'hiding' => 5,
                   2283:         'behaviour_of_input_fields' => 6,
                   2284:         'high_level_randomization'  => 7,
                   2285:         'slots' => 8,
                   2286:         'file_submission' => 9,
                   2287:         'misc' => 10
                   2288:     );
                   2289: 
                   2290: }
1.453     schualex 2291: 
1.562     damieng  2292: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2293: #
                   2294: # @param {Apache2::RequestRec} $r - the Apache request
                   2295: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2296: # @param {array reference} $pscat - list of selected parameter names
                   2297: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2298: sub parmboxes {
                   2299:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2300:     my %categories = &categories();
1.467     amueller 2301:     my %category_order = &category_order();
1.465     amueller 2302:     my %categoryList = (
                   2303:         'time_settings' => [],
                   2304:         'grading' => [],
                   2305:         'tries' => [],
                   2306:         'problem_appearance' => [],
                   2307:         'behaviour_of_input_fields' => [],
                   2308:         'hiding' => [],
                   2309:         'high_level_randomization' => [],
                   2310:         'slots' => [],
                   2311:         'file_submission' => [],
                   2312:         'misc' => [],
1.489     bisitz   2313:     );
1.510     www      2314: 
1.548     raeburn  2315:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2316:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2317:     }
1.453     schualex 2318:     #part to print the parm-list
1.536     raeburn  2319:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2320:         next if (@{$categoryList{$key}} == 0);
                   2321:         next if ($key eq '');
                   2322:         $r->print('<div class="LC_Box LC_400Box">'
                   2323:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2324:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2325:             next if ($tempkey eq '');
1.536     raeburn  2326:             $r->print('<span class="LC_nobreak">'
                   2327:                      .'<label><input type="checkbox" name="pscat" '
                   2328:                      .'value="'.$tempkey.'" ');
                   2329:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2330:                 $r->print( ' checked="checked"');
                   2331:             }
                   2332:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2333:                                                       : $tempkey)
1.536     raeburn  2334:                      .'</label></span><br />'."\n");
1.465     amueller 2335:         }
1.536     raeburn  2336:         $r->print('</div>');
1.465     amueller 2337:     }
1.536     raeburn  2338:     $r->print("\n");
1.453     schualex 2339: }
1.562     damieng  2340: 
                   2341: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2342: #
1.562     damieng  2343: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2344: sub shortCuts {
1.581     raeburn  2345:     my ($r)=@_;
1.453     schualex 2346: 
1.491     bisitz   2347:     # Parameter Selection
                   2348:     $r->print(
                   2349:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2350:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2351:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2352:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2353:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2354:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2355:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2356:        .&Apache::lonhtmlcommon::end_funclist()
                   2357:     );
                   2358: 
                   2359:     # Add Selection for...
                   2360:     $r->print(
                   2361:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2362:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2363:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2364:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2365:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2366:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2367:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2368:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2369:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2370:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2371:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2372:        .&Apache::lonhtmlcommon::end_funclist()
                   2373:     );
1.208     www      2374: }
                   2375: 
1.562     damieng  2376: # Prints HTML to select parts to view (except for the title).
                   2377: # Used by table and overview modes.
                   2378: #
                   2379: # @param {Apache2::RequestRec} $r - the Apache request
                   2380: # @param {hash reference} $allparts - hash parameter part -> part title
                   2381: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2382: sub partmenu {
1.446     bisitz   2383:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2384:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2385:     if ($selsize > 8) {
                   2386:         $selsize = 8;
                   2387:     }
1.446     bisitz   2388: 
1.523     raeburn  2389:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2390:     $r->print('<option value="all"');
1.562     damieng  2391:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2392:     $r->print('>'.&mt('All Parts').'</option>');
                   2393:     my %temphash=();
                   2394:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2395:     foreach my $tempkey (sort {
1.560     damieng  2396:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2397:             } keys(%{$allparts})) {
                   2398:         unless ($tempkey =~ /\./) {
                   2399:             $r->print('<option value="'.$tempkey.'"');
                   2400:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2401:                 $r->print(' selected="selected"');
                   2402:             }
                   2403:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2404:         }
1.208     www      2405:     }
1.446     bisitz   2406:     $r->print('</select>');
1.209     www      2407: }
                   2408: 
1.562     damieng  2409: # Prints HTML to select a user and/or a group.
                   2410: # Used by table mode.
                   2411: #
                   2412: # @param {Apache2::RequestRec} $r - the Apache request
                   2413: # @param {string} $uname - selected user name
                   2414: # @param {string} $id - selected Student/Employee ID
                   2415: # @param {string} $udom - selected user domain
                   2416: # @param {string} $csec - selected section name
                   2417: # @param {string} $cgroup - selected group name
                   2418: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2419: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2420: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2421: sub usermenu {
1.553     raeburn  2422:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2423:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2424:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2425:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2426: 
1.209     www      2427:     my $sections='';
1.300     albertel 2428:     my %sectionhash = &Apache::loncommon::get_sections();
                   2429: 
1.269     raeburn  2430:     my $groups;
1.553     raeburn  2431:     my %grouphash;
                   2432:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2433:         %grouphash = &Apache::longroup::coursegroups();
                   2434:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2435:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2436:     }
1.299     albertel 2437: 
1.412     bisitz   2438:     my $g_s_header='';
                   2439:     my $g_s_footer='';
1.446     bisitz   2440: 
1.552     raeburn  2441:     my $currsec = $env{'request.course.sec'};
                   2442:     if ($currsec) {
                   2443:         $sections=&mt('Section:').' '.$currsec;
                   2444:         if (%grouphash) {
                   2445:             $sections .= ';'.('&nbsp;' x2);
                   2446:         }
                   2447:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2448:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2449:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2450:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2451:         }
                   2452:         $sections .= '>';
1.548     raeburn  2453:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2454:         $sections.='<option value="'.$section.'" '.
                   2455:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2456:                                                               '</option>';
1.209     www      2457:         }
                   2458:         $sections.='</select>';
1.269     raeburn  2459:     }
1.412     bisitz   2460: 
1.552     raeburn  2461:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2462:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2463:         $sections .= qq|
                   2464: <script type="text/javascript">
1.454     bisitz   2465: // <![CDATA[
1.269     raeburn  2466: function group_or_section(caller) {
                   2467:    if (caller == "cgroup") {
                   2468:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2469:            document.parmform.csec.selectedIndex = 0;
                   2470:        }
                   2471:    } else {
                   2472:        if (document.parmform.csec.selectedIndex != 0) {
                   2473:            document.parmform.cgroup.selectedIndex = 0;
                   2474:        }
                   2475:    }
                   2476: }
1.454     bisitz   2477: // ]]>
1.269     raeburn  2478: </script>
                   2479: |;
1.554     raeburn  2480:     } else {
1.269     raeburn  2481:         $sections .= qq|
                   2482: <script type="text/javascript">
1.454     bisitz   2483: // <![CDATA[
1.269     raeburn  2484: function group_or_section(caller) {
                   2485:     return;
                   2486: }
1.454     bisitz   2487: // ]]>
1.269     raeburn  2488: </script>
                   2489: |;
1.446     bisitz   2490:     }
1.299     albertel 2491: 
                   2492:     if (%grouphash) {
1.412     bisitz   2493:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2494:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2495:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2496:         }
                   2497:         $groups .= '>';
1.548     raeburn  2498:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2499:             $groups.='<option value="'.$grp.'" ';
                   2500:             if ($grp eq $cgroup) {
                   2501:                 unless ((defined($uname)) && ($grp eq '')) {
                   2502:                     $groups .=  'selected="selected" ';
                   2503:                 }
                   2504:             } elsif (!defined($cgroup)) {
                   2505:                 if (@{$usersgroups} == 1) {
                   2506:                     if ($grp eq $$usersgroups[0]) {
                   2507:                         $groups .=  'selected="selected" ';
                   2508:                     }
                   2509:                 }
                   2510:             }
                   2511:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2512:         }
                   2513:         $groups.='</select>';
                   2514:     }
1.412     bisitz   2515: 
1.445     neumanie 2516:     if (%sectionhash || %grouphash) {
1.446     bisitz   2517:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2518:         $r->print($sections.$groups);
1.448     bisitz   2519:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2520:     } else {
                   2521:         $r->print($sections); 
1.445     neumanie 2522:     }
1.446     bisitz   2523: 
                   2524:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2525:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2526:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2527:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2528:                  ,$chooseopt));
1.209     www      2529: }
                   2530: 
1.562     damieng  2531: # Prints HTML to select parameters from a list of all parameters.
                   2532: # Uses parmmenu and parmboxes.
                   2533: # Used by table and overview modes.
1.468     amueller 2534: #
1.562     damieng  2535: # @param {Apache2::RequestRec} $r - the Apache request
                   2536: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2537: # @param {array reference} $pscat - list of selected parameter names
                   2538: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2539: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2540: sub displaymenu {
1.581     raeburn  2541:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2542: 
1.445     neumanie 2543:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2544:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2545: 
1.581     raeburn  2546:     &parmmenu($r);
1.536     raeburn  2547:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2548:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2549:     $r->print(&Apache::loncommon::end_scrollbox());
                   2550: 
                   2551:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2552:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2553:  
1.209     www      2554: }
                   2555: 
1.562     damieng  2556: # Prints HTML to select a map.
                   2557: # Used by table mode and overview mode.
                   2558: #
                   2559: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2560: # @param {hash reference} $allmaps - hash map pc -> map src
                   2561: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2562: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2563: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2564: sub mapmenu {
1.499     raeburn  2565:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2566:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2567:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2568:     my $tree=[];
                   2569:     my $treeinfo={};
                   2570:     if (defined($navmap)) {
1.499     raeburn  2571:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2572:         my $curRes;
                   2573:         my $depth = 0;
1.468     amueller 2574:         my %parent = ();
                   2575:         my $startcount = 5;
                   2576:         my $lastcontainer = $startcount;
                   2577: # preparing what is to show ...
1.461     neumanie 2578:         while ($curRes = $it->next()) {
                   2579:             if ($curRes == $it->BEGIN_MAP()) {
                   2580:                 $depth++;
1.468     amueller 2581:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2582:             }
                   2583:             if ($curRes == $it->END_MAP()) {
                   2584:                 $depth--;
1.468     amueller 2585:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2586:             }
                   2587:             if (ref($curRes)) {
1.468     amueller 2588:                 my $symb = $curRes->symb();
                   2589:                 my $ressymb = $symb;
1.461     neumanie 2590:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2591:                     my $type = 'sequence';
                   2592:                     if ($curRes->is_page()) {
                   2593:                         $type = 'page';
                   2594:                     }
                   2595:                     my $id= $curRes->id();
1.468     amueller 2596:                     my $srcf = $curRes->src();
                   2597:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2598:                     if(!exists($treeinfo->{$id})) {
                   2599:                         push(@$tree,$id);
1.473     amueller 2600:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2601:                         $treeinfo->{$id} = {
1.461     neumanie 2602:                                     depth => $depth,
                   2603:                                     type  => $type,
1.468     amueller 2604:                                     name  => $resource_name,
                   2605:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2606:                                     };
1.462     neumanie 2607:                     }
1.461     neumanie 2608:                 }
                   2609:             }
                   2610:         }
1.462     neumanie 2611:     }
1.473     amueller 2612: # Show it ...    
1.484     amueller 2613:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2614:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2615:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2616:         my $whitespace =
                   2617:             '<img src="'
                   2618:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2619:            .'" alt="" />';
                   2620: 
1.498     bisitz   2621:         # Info about selectable folders/maps
                   2622:         $r->print(
                   2623:             '<div class="LC_info">'
1.508     www      2624:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2625:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2626:            .'</div>'
                   2627:         );
                   2628: 
1.536     raeburn  2629:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2630:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2631: 
1.498     bisitz   2632:         # Display row: "All Maps or Folders"
                   2633:         $r->print(
1.523     raeburn  2634:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2635:            .'<td>'
                   2636:            .'<label>'
                   2637:            .'<input type="radio" name="pschp"'
1.497     bisitz   2638:         );
                   2639:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2640:         $r->print(
                   2641:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2642:            .&mt('All Maps or Folders')
                   2643:            .'</label>'
                   2644:            .'<hr /></td>'
                   2645:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2646:         );
1.497     bisitz   2647: 
1.532     raeburn  2648:         # Display row: "Main Content"
1.468     amueller 2649:         if (exists($$allmaps{1})) {
1.498     bisitz   2650:             $r->print(
                   2651:                 &Apache::loncommon::start_data_table_row()
                   2652:                .'<td>'
                   2653:                .'<label>'
                   2654:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2655:             );
1.497     bisitz   2656:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2657:             $r->print(
                   2658:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2659:                .$$maptitles{1}
                   2660:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2661:                .'</label>'
                   2662:                .'</td>'
                   2663:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2664:             );
                   2665:         }
1.497     bisitz   2666: 
                   2667:         # Display rows for all course maps and folders
1.468     amueller 2668:         foreach my $id (@{$tree}) {
                   2669:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2670:             # Indentation
1.468     amueller 2671:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2672:             my $indent;
                   2673:             for (my $i = 0; $i < $depth; $i++) {
                   2674:                 $indent.= $whitespace;
                   2675:             }
1.461     neumanie 2676:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2677:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2678:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2679:             }
1.468     amueller 2680:             my $symb_name = $$symbp{$id};
                   2681:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2682:             $symb_name = $tail;
1.498     bisitz   2683:             $r->print(
                   2684:                 &Apache::loncommon::start_data_table_row()
                   2685:                .'<td>'
                   2686:                .'<label>'
1.463     bisitz   2687:             );
1.498     bisitz   2688:             # Only offer radio button for folders/maps which can be parameterized
                   2689:             if ($allmaps_inverted{$symb_name}) {
                   2690:                 $r->print(
                   2691:                     '<input type ="radio" name="pschp"'
                   2692:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2693:                 );
                   2694:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2695:                 $r->print('/>');
                   2696:             } else {
                   2697:                 $r->print($whitespace);
1.461     neumanie 2698:             }
1.498     bisitz   2699:             $r->print(
                   2700:                 $indent.$icon.'&nbsp;'
                   2701:                .$treeinfo->{$id}->{name}
                   2702:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2703:                .'</label>'
                   2704:                .'</td>'
                   2705:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2706:             );
1.461     neumanie 2707:         }
1.497     bisitz   2708: 
1.523     raeburn  2709:         $r->print(&Apache::loncommon::end_data_table().
                   2710:                   '<br style="line-height:2px;" />'.
                   2711:                   &Apache::loncommon::end_scrollbox());
1.209     www      2712:     }
                   2713: }
                   2714: 
1.563     damieng  2715: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2716: # Used by table and overview modes.
                   2717: #
                   2718: # @param {Apache2::RequestRec} $r - the Apache request
                   2719: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2720: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2721: sub levelmenu {
1.446     bisitz   2722:     my ($r,$alllevs,$parmlev)=@_;
                   2723: 
1.548     raeburn  2724:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2725:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2726:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2727:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2728:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2729:         if ($parmlev eq $$alllevs{$lev}) {
                   2730:             $r->print(' selected="selected"');
                   2731:         }
                   2732:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2733:     }
1.446     bisitz   2734:     $r->print("</select>");
1.208     www      2735: }
                   2736: 
1.211     www      2737: 
1.563     damieng  2738: # Returns HTML to select a section (with a select HTML element).
                   2739: # Used by overview mode.
                   2740: #
                   2741: # @param {array reference} $selectedsections - list of selected section ids
                   2742: # @returns {string}
1.211     www      2743: sub sectionmenu {
1.553     raeburn  2744:     my ($selectedsections)=@_;
1.300     albertel 2745:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2746:     return '' if (!%sectionhash);
1.300     albertel 2747: 
1.552     raeburn  2748:     my (@possibles,$disabled);
                   2749:     if ($env{'request.course.sec'} ne '') {
                   2750:         @possibles = ($env{'request.course.sec'});
                   2751:         $selectedsections = [$env{'request.course.sec'}];
                   2752:         $disabled = ' disabled="disabled"';
                   2753:     } else {
                   2754:         @possibles = ('all',sort(keys(%sectionhash)));
                   2755:     }
1.553     raeburn  2756:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2757:     foreach my $s (@possibles) {
1.553     raeburn  2758:         $output .= '    <option value="'.$s.'"';
                   2759:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2760:             $output .= ' selected="selected"';
1.473     amueller 2761:         }
1.553     raeburn  2762:         $output .= '>'."$s</option>\n";
1.300     albertel 2763:     }
1.553     raeburn  2764:     $output .= "</select>\n";
                   2765:     return $output;
1.269     raeburn  2766: }
                   2767: 
1.563     damieng  2768: # Returns HTML to select a group (with a select HTML element).
                   2769: # Used by overview mode.
                   2770: #
                   2771: # @param {array reference} $selectedgroups - list of selected group names
                   2772: # @returns {string}
1.269     raeburn  2773: sub groupmenu {
1.553     raeburn  2774:     my ($selectedgroups)=@_;
                   2775:     my %grouphash;
                   2776:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2777:         %grouphash = &Apache::longroup::coursegroups();
                   2778:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2779:          map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2780:     }
                   2781:     return '' if (!%grouphash);
1.299     albertel 2782: 
1.553     raeburn  2783:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2784:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2785:         $output .= '    <option value="'.$group.'"';
                   2786:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2787:             $output .=  ' selected="selected"';
1.473     amueller 2788:         }
1.553     raeburn  2789:         $output .= '>'."$group</option>\n";
1.211     www      2790:     }
1.553     raeburn  2791:     $output .= "</select>\n";
                   2792:     return $output;
1.211     www      2793: }
                   2794: 
1.563     damieng  2795: # Returns an array with the given parameter split by comma.
                   2796: # Used by assessparms (table mode).
                   2797: #
                   2798: # @param {string} $keyp - the string to split
                   2799: # @returns {Array<string>}
1.210     www      2800: sub keysplit {
                   2801:     my $keyp=shift;
                   2802:     return (split(/\,/,$keyp));
                   2803: }
                   2804: 
1.563     damieng  2805: # Returns the keys in $name, sorted using $keyorder.
                   2806: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2807: # Used by assessparms (table mode) for resource level.
                   2808: #
                   2809: # @param {hash reference} $name - parameter key -> parameter name
                   2810: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2811: # @returns {Array<string>}
1.210     www      2812: sub keysinorder {
                   2813:     my ($name,$keyorder)=@_;
                   2814:     return sort {
1.560     damieng  2815:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2816:     } (keys(%{$name}));
1.210     www      2817: }
                   2818: 
1.563     damieng  2819: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2820: # Used by assessparms (table mode) for map and general levels.
                   2821: #
                   2822: # @param {hash reference} $name - parameter key -> parameter name
                   2823: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2824: # @returns {Array<string>}
1.236     albertel 2825: sub keysinorder_bytype {
                   2826:     my ($name,$keyorder)=@_;
                   2827:     return sort {
1.563     damieng  2828:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2829:         my $tb=(split('_',$b))[-1];
                   2830:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2831:             return ($a cmp $b);
                   2832:         }
                   2833:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2834:     } (keys(%{$name}));
1.236     albertel 2835: }
                   2836: 
1.563     damieng  2837: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2838: # Used by defaultsetter (parameter settings default actions).
                   2839: #
                   2840: # @param {hash reference} $name - hash parameter name -> parameter title
                   2841: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2842: # @returns {Array<string>}
1.211     www      2843: sub keysindisplayorder {
                   2844:     my ($name,$keyorder)=@_;
                   2845:     return sort {
1.560     damieng  2846:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2847:     } (keys(%{$name}));
1.211     www      2848: }
                   2849: 
1.563     damieng  2850: # Prints HTML with a choice to sort results by realm or student first.
                   2851: # Used by overview mode.
                   2852: #
                   2853: # @param {Apache2::RequestRec} $r - the Apache request
                   2854: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2855: sub sortmenu {
                   2856:     my ($r,$sortorder)=@_;
1.236     albertel 2857:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2858:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2859:        $r->print(' checked="checked"');
1.214     www      2860:     }
                   2861:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2862:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2863:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2864:        $r->print(' checked="checked"');
1.214     www      2865:     }
1.236     albertel 2866:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2867:           '</label>');
1.214     www      2868: }
                   2869: 
1.563     damieng  2870: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2871: #
                   2872: # @returns {hash}
1.211     www      2873: sub standardkeyorder {
                   2874:     return ('parameter_0_opendate' => 1,
1.473     amueller 2875:         'parameter_0_duedate' => 2,
                   2876:         'parameter_0_answerdate' => 3,
                   2877:         'parameter_0_interval' => 4,
                   2878:         'parameter_0_weight' => 5,
                   2879:         'parameter_0_maxtries' => 6,
                   2880:         'parameter_0_hinttries' => 7,
                   2881:         'parameter_0_contentopen' => 8,
                   2882:         'parameter_0_contentclose' => 9,
                   2883:         'parameter_0_type' => 10,
                   2884:         'parameter_0_problemstatus' => 11,
                   2885:         'parameter_0_hiddenresource' => 12,
                   2886:         'parameter_0_hiddenparts' => 13,
                   2887:         'parameter_0_display' => 14,
                   2888:         'parameter_0_ordered' => 15,
                   2889:         'parameter_0_tol' => 16,
                   2890:         'parameter_0_sig' => 17,
                   2891:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2892:         'parameter_0_discussend' => 19,
                   2893:         'parameter_0_discusshide' => 20,
                   2894:         'parameter_0_discussvote' => 21,
1.560     damieng  2895:         'parameter_0_printstartdate'  =>  22,
                   2896:         'parameter_0_printenddate' =>  23);
1.211     www      2897: }
                   2898: 
1.59      matthew  2899: 
1.560     damieng  2900: # Table mode UI.
1.563     damieng  2901: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2902: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2903: #
                   2904: # Parameters used from the request:
                   2905: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2906: # cgroup - selected group
                   2907: # command - 'set': direct access to table mode for a resource
                   2908: # csec - selected section
                   2909: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2910: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2911: # id - student/employee ID
                   2912: # parmlev - selected level (full|map|general)
                   2913: # part - selected part (unused ?)
                   2914: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2915: # pres_type - &&&-separated parameter types
                   2916: # pres_value - &&&-separated parameter values
                   2917: # prevvisit - '1' if the user has submitted the form before
                   2918: # pscat (multiple values) - selected parameter names
1.566     damieng  2919: # pschp - selected map pc, or 'all'
1.563     damieng  2920: # psprt (multiple values) - list of selected parameter parts
                   2921: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2922: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2923: # symb - resource symb (when a single resource is selected)
                   2924: # udom - selected user domain
                   2925: # uname - selected user name
                   2926: # url - used only with command 'set', the resource url
                   2927: #
                   2928: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2929: # @param $parm_permission - ref to hash of permissions
                   2930: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2931: sub assessparms {
1.1       www      2932: 
1.568     raeburn  2933:     my ($r,$parm_permission) = @_;
1.201     www      2934: 
1.512     foxr     2935: 
                   2936: # -------------------------------------------------------- Variable declaration
1.566     damieng  2937:     my @ids=(); # resource and map ids
                   2938:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2939:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2940:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2941:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2942:     my %uris=(); # hash resource/map id -> resource src
                   2943:     my %maptitles=(); # hash map pc or src -> map title
                   2944:     my %allmaps=(); # hash map pc -> map src
1.582     raeburn  2945:     my %allmaps_inverted=(); # hash map src -> map pc
1.563     damieng  2946:     my %alllevs=(); # hash English level title -> value
                   2947: 
                   2948:     my $uname; # selected user name
                   2949:     my $udom; # selected user domain
                   2950:     my $uhome; # server with the user's files, or 'no_host'
                   2951:     my $csec; # selected section name
                   2952:     my $cgroup; # selected group name
                   2953:     my @usersgroups = (); # list of the user groups
1.582     raeburn  2954:     my $numreclinks = 0;
1.446     bisitz   2955: 
1.190     albertel 2956:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2957: 
1.57      albertel 2958:     $alllevs{'Resource Level'}='full';
1.215     www      2959:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2960:     $alllevs{'Course Level'}='general';
                   2961: 
1.563     damieng  2962:     my %allparms; # hash parameter name -> parameter title
                   2963:     my %allparts; # hash parameter part -> part title
1.512     foxr     2964: # ------------------------------------------------------------------------------
                   2965: 
1.210     www      2966: #
                   2967: # Order in which these parameters will be displayed
                   2968: #
1.211     www      2969:     my %keyorder=&standardkeyorder();
                   2970: 
1.512     foxr     2971: #    @ids=();
                   2972: #    %symbp=();       # These seem defined above already.
                   2973: #    %typep=();
1.43      albertel 2974: 
                   2975:     my $message='';
                   2976: 
1.190     albertel 2977:     $csec=$env{'form.csec'};
1.552     raeburn  2978:     if ($env{'request.course.sec'} ne '') {
                   2979:         $csec = $env{'request.course.sec'};    
                   2980:     }
                   2981: 
1.553     raeburn  2982: # Check group privs.
1.269     raeburn  2983:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2984:     my $noeditgrp; 
                   2985:     if ($cgroup ne '') {
                   2986:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2987:             if (($env{'request.course.groups'} eq '') || 
1.585     raeburn  2988:                 (!grep(/^\Q$cgroup\E$/,split(/:/,$env{'request.course.groups'})))) {
1.553     raeburn  2989:                 $noeditgrp = 1;
                   2990:             }
                   2991:         }
                   2992:     }
1.188     www      2993: 
1.190     albertel 2994:     if      ($udom=$env{'form.udom'}) {
                   2995:     } elsif ($udom=$env{'request.role.domain'}) {
                   2996:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2997:     } else {
1.473     amueller 2998:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2999:     }
1.468     amueller 3000:     
1.43      albertel 3001: 
1.134     albertel 3002:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 3003:     my $pschp=$env{'form.pschp'};
1.506     www      3004: 
                   3005: 
1.134     albertel 3006:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      3007:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      3008:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 3009: 
1.43      albertel 3010:     my $pssymb='';
1.57      albertel 3011:     my $parmlev='';
1.446     bisitz   3012: 
1.190     albertel 3013:     unless ($env{'form.parmlev'}) {
1.57      albertel 3014:         $parmlev = 'map';
                   3015:     } else {
1.190     albertel 3016:         $parmlev = $env{'form.parmlev'};
1.57      albertel 3017:     }
1.26      www      3018: 
1.29      www      3019: # ----------------------------------------------- Was this started from grades?
                   3020: 
1.560     damieng  3021:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   3022:             (!$env{'form.dis'})) {
1.473     amueller 3023:         my $url=$env{'form.url'};
                   3024:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   3025:         $pssymb=&Apache::lonnet::symbread($url);
                   3026:         if (!@pscat) { @pscat=('all'); }
                   3027:         $pschp='';
1.57      albertel 3028:         $parmlev = 'full';
1.190     albertel 3029:     } elsif ($env{'form.symb'}) {
1.473     amueller 3030:         $pssymb=$env{'form.symb'};
                   3031:         if (!@pscat) { @pscat=('all'); }
                   3032:         $pschp='';
1.57      albertel 3033:         $parmlev = 'full';
1.43      albertel 3034:     } else {
1.473     amueller 3035:         $env{'form.url'}='';
1.43      albertel 3036:     }
                   3037: 
1.190     albertel 3038:     my $id=$env{'form.id'};
1.43      albertel 3039:     if (($id) && ($udom)) {
1.555     raeburn  3040:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 3041:         if ($uname) {
                   3042:             $id='';
                   3043:         } else {
                   3044:             $message=
1.540     bisitz   3045:                 '<p class="LC_warning">'.
                   3046:                 &mt('Unknown ID [_1] at domain [_2]',
                   3047:                     "'".$id."'","'".$udom."'").
                   3048:                 '</p>';
1.473     amueller 3049:         }
1.43      albertel 3050:     } else {
1.473     amueller 3051:         $uname=$env{'form.uname'};
1.43      albertel 3052:     }
                   3053:     unless ($udom) { $uname=''; }
                   3054:     $uhome='';
                   3055:     if ($uname) {
1.473     amueller 3056:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 3057:         if ($uhome eq 'no_host') {
1.473     amueller 3058:             $message=
1.540     bisitz   3059:                 '<p class="LC_warning">'.
                   3060:                 &mt('Unknown user [_1] at domain [_2]',
                   3061:                     "'".$uname."'","'".$udom."'").
                   3062:                 '</p>';
1.473     amueller 3063:             $uname='';
1.12      www      3064:         } else {
1.473     amueller 3065:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   3066:                           $env{'request.course.id'});
                   3067:             if ($csec eq '-1') {
1.540     bisitz   3068:                 $message=
                   3069:                     '<p class="LC_warning">'.
                   3070:                     &mt('User [_1] at domain [_2] not in this course',
                   3071:                         "'".$uname."'","'".$udom."'").
                   3072:                     '</p>';
1.473     amueller 3073:                 $uname='';
                   3074:                 $csec=$env{'form.csec'};
1.269     raeburn  3075:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 3076:             } else {
                   3077:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   3078:                   ('firstname','middlename','lastname','generation','id'));
                   3079:                 $message="\n<p>\n".&mt("Full Name").": ".
                   3080:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   3081:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   3082:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 3083:             }
1.297     raeburn  3084:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  3085:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  3086:             if (@usersgroups > 0) {
1.306     albertel 3087:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  3088:                     $cgroup = $usersgroups[0];
1.297     raeburn  3089:                 }
1.269     raeburn  3090:             }
1.12      www      3091:         }
1.43      albertel 3092:     }
1.2       www      3093: 
1.43      albertel 3094:     unless ($csec) { $csec=''; }
1.269     raeburn  3095:     unless ($cgroup) { $cgroup=''; }
1.12      www      3096: 
1.14      www      3097: # --------------------------------------------------------- Get all assessments
1.446     bisitz   3098:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3099:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3100:                 \%keyorder);
1.63      bowersj2 3101: 
1.582     raeburn  3102:     %allmaps_inverted = reverse(%allmaps);
                   3103: 
1.57      albertel 3104:     $mapp{'0.0'} = '';
                   3105:     $symbp{'0.0'} = '';
1.99      albertel 3106: 
1.14      www      3107: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  3108:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      3109:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   3110:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   3111:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  3112:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3113:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  3114:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   3115:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   3116:         my $totalstored = 0;
1.546     raeburn  3117:         my $now = time;
1.473     amueller 3118:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  3119:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  3120:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  3121:                 next if ($csec ne $env{'request.course.sec'});
                   3122:             }
1.556     raeburn  3123:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  3124:                 next if ($noeditgrp);
1.557     raeburn  3125:             }
                   3126:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   3127:                 $namematch = 'maplevelrecurse';
                   3128:             }
1.556     raeburn  3129:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  3130:                 my (@ok_slots,@fail_slots,@del_slots);
                   3131:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   3132:                 my ($level,@all) =
                   3133:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   3134:                                      $csec,$cgroup,$courseopt);
                   3135:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   3136:                     next if ($slot_name eq '');
                   3137:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   3138:                         push(@ok_slots,$slot_name);
                   3139: 
                   3140:                     } else {
                   3141:                         push(@fail_slots,$slot_name);
                   3142:                     }
                   3143:                 }
                   3144:                 if (@ok_slots) {
                   3145:                     $values[$i] = join(':',@ok_slots);
                   3146:                 } else {
                   3147:                     $values[$i] = '';
                   3148:                 }
                   3149:                 if ($all[$level] ne '') {
                   3150:                     my @existing = split(/:/,$all[$level]);
                   3151:                     foreach my $slot_name (@existing) {
                   3152:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   3153:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   3154:                                 push(@del_slots,$slot_name);
                   3155:                             }
                   3156:                         }
                   3157:                     }
                   3158:                 }
1.554     raeburn  3159:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  3160:                 $name = $1;
1.533     raeburn  3161:                 my $val = $values[$i];
1.549     raeburn  3162:                 my $valmatch = '';
1.533     raeburn  3163:                 if ($name eq 'examcode') {
1.544     raeburn  3164:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   3165:                         $val = 'valid';
                   3166:                     }
1.546     raeburn  3167:                 } elsif ($name eq 'printstartdate') {
                   3168:                     if ($val =~ /^\d+$/) {
                   3169:                         if ($val > $now) {
                   3170:                             $val = 'future';
                   3171:                         }
                   3172:                     } 
                   3173:                 } elsif ($name eq 'printenddate') {
                   3174:                     if ($val =~ /^\d+$/) {
                   3175:                         if ($val < $now) {
                   3176:                             $val = 'past';
                   3177:                         }
                   3178:                     }
1.549     raeburn  3179:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   3180:                     my $stringtype = &get_stringtype($name);
                   3181:                     my $stringmatch = &standard_string_matches($stringtype);
                   3182:                     if (ref($stringmatch) eq 'ARRAY') {
                   3183:                         foreach my $item (@{$stringmatch}) {
                   3184:                             if (ref($item) eq 'ARRAY') {
                   3185:                                 my ($regexpname,$pattern) = @{$item};
                   3186:                                 if ($pattern ne '') {
                   3187:                                     if ($val =~ /$pattern/) {
                   3188:                                         $valmatch = $regexpname;
                   3189:                                         $val = '';
                   3190:                                         last;
                   3191:                                     }
                   3192:                                 }
                   3193:                             }
                   3194:                         }
                   3195:                     }
1.554     raeburn  3196:                 } elsif ($name eq 'interval') {
                   3197:                     my $intervaltype = &get_intervaltype($name);
                   3198:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   3199:                     if (ref($intervalmatch) eq 'ARRAY') {
                   3200:                         foreach my $item (@{$intervalmatch}) {
                   3201:                             if (ref($item) eq 'ARRAY') {
                   3202:                                 my ($regexpname,$pattern) = @{$item};
                   3203:                                 if ($pattern ne '') {
                   3204:                                     if ($val =~ /$pattern/) {
                   3205:                                         $valmatch = $regexpname;
                   3206:                                         $val = '';
                   3207:                                         last;
                   3208:                                     }
                   3209:                                 }
                   3210:                             }
                   3211:                         }
                   3212:                     }
1.533     raeburn  3213:                 }
1.504     raeburn  3214:                 $needsrelease =
1.557     raeburn  3215:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  3216:                 if ($needsrelease) {
1.505     raeburn  3217:                     unless ($got_chostname) {
1.514     raeburn  3218:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  3219:                         $got_chostname = 1;
1.546     raeburn  3220:                     } 
1.557     raeburn  3221:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  3222:                                                           $needsrelease,
                   3223:                                                           $cmajor,$cminor);
1.500     raeburn  3224:                 }
1.437     raeburn  3225:             }
1.504     raeburn  3226:             if ($needsnewer) {
1.557     raeburn  3227:                 undef($namematch);
                   3228:             } else {
                   3229:                 my $currneeded;
                   3230:                 if ($needsrelease) {
                   3231:                     $currneeded = $needsrelease;
                   3232:                 }
                   3233:                 if ($namematch) {
                   3234:                     $needsrelease =
                   3235:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3236:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3237:                         unless ($got_chostname) {
                   3238:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3239:                             $got_chostname = 1;
                   3240:                         }
                   3241:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3242:                                                               $needsrelease,
                   3243:                                                               $cmajor,$cminor);
                   3244:                     } else {
                   3245:                         undef($namematch);
                   3246:                     }
                   3247:                 }
                   3248:             }
                   3249:             if ($needsnewer) {
                   3250:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3251:                                                 $cminor,$needsrelease);
                   3252:             } else {
                   3253:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3254:                                      $values[$i],
                   3255:                                      $types[$i],
                   3256:                                      $uname,$udom,$csec,$cgroup);
                   3257:                 $totalstored ++;
                   3258:             }
1.473     amueller 3259:         }
1.68      www      3260: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3261:         if ($totalstored) {
                   3262:             $message.='<p class="LC_warning">'
                   3263:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3264:                      .&Apache::loncommon::help_open_topic('Caching')
                   3265:                      .'</p>';
                   3266:         }
1.68      www      3267:     }
1.584     raeburn  3268: 
1.57      albertel 3269: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3270:     if ($pscat[0] eq "all") {
                   3271:         @pscat = (keys(%allparms));
                   3272:     }
                   3273:     if (!@pscat) {
                   3274:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3275:     };
                   3276:     if ($psprt[0] eq "all" || !@psprt) {
                   3277:         @psprt = (keys(%allparts));
                   3278:     }
1.2       www      3279: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3280: 
1.531     raeburn  3281:     my $crstype = &Apache::loncommon::course_type();
                   3282:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3283: 
1.548     raeburn  3284:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.589     raeburn  3285:             'date_interval','int','float','string','string_lenient',
                   3286:             'string_examcode','string_deeplink','string_discussvote',
                   3287:             'string_useslots','string_problemstatus','string_ip',
                   3288:             'string_questiontype') {
1.473     amueller 3289:         $r->print('<input type="hidden" value="'.
1.563     damieng  3290:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3291:             '" name="recent_'.$item.'" />');
1.44      albertel 3292:     }
1.446     bisitz   3293: 
1.459     bisitz   3294:     # ----- Start Parameter Selection
                   3295: 
                   3296:     # Hide parm selection?
                   3297:     $r->print(<<ENDPARMSELSCRIPT);
                   3298: <script type="text/javascript">
                   3299: // <![CDATA[
                   3300: function parmsel_show() {
1.562     damieng  3301:     document.getElementById('parmsel').style.display = "";
                   3302:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3303: }
                   3304: // ]]>
                   3305: </script>
                   3306: ENDPARMSELSCRIPT
1.474     amueller 3307:     
1.445     neumanie 3308:     if (!$pssymb) {
1.563     damieng  3309:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3310:         my $parmselhiddenstyle=' style="display:none"';
                   3311:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3312:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3313:         } else  {
                   3314:            $r->print('<div id="parmsel">');
                   3315:         }
                   3316: 
1.491     bisitz   3317:         # Step 1
1.523     raeburn  3318:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3319:         $r->print('
1.474     amueller 3320: <script type="text/javascript">
1.523     raeburn  3321: // <![CDATA['.
                   3322:                  &showhide_js().'
1.474     amueller 3323: // ]]>
                   3324: </script>
1.523     raeburn  3325: ');
                   3326:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3327:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3328:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3329:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3330:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3331:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3332:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3333:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3334:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3335: 
                   3336:         # Step 2
1.523     raeburn  3337:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581     raeburn  3338:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3339: 
                   3340:         # Step 3
1.523     raeburn  3341:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3342:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3343:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3344:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3345:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3346: 
                   3347:         # Update Display Button
1.486     www      3348:         $r->print('<p>'
                   3349:              .'<input type="submit" name="dis"'
1.511     www      3350:              .' value="'.&mt('Update Display').'" />'
1.486     www      3351:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3352:              .'</p>');
                   3353:         $r->print('</div>');
1.491     bisitz   3354: 
1.486     www      3355:         # Offer link to display parameter selection again
                   3356:         $r->print('<p id="parmsellink"');
                   3357:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3358:            $r->print($parmselhiddenstyle);
                   3359:         }
                   3360:         $r->print('>'
                   3361:              .'<a href="javascript:parmsel_show()">'
                   3362:              .&mt('Change Parameter Selection')
                   3363:              .'</a>'
                   3364:              .'</p>');
1.44      albertel 3365:     } else {
1.478     amueller 3366:         # parameter screen for a single resource. 
1.486     www      3367:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3368:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3369:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3370:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3371:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3372:                   '<br />');
                   3373:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3374:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3375:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3376:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3377:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3378:         $r->print('<p>'
1.459     bisitz   3379:              .'<input type="submit" name="dis"'
1.511     www      3380:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3381:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3382:              .'</p>');
1.459     bisitz   3383:     }
1.478     amueller 3384:     
1.486     www      3385:     # ----- End Parameter Selection
1.57      albertel 3386: 
1.459     bisitz   3387:     # Display Messages
                   3388:     $r->print('<div>'.$message.'</div>');
1.210     www      3389: 
1.57      albertel 3390: 
                   3391:     my @temp_pscat;
                   3392:     map {
                   3393:         my $cat = $_;
                   3394:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3395:     } @pscat;
                   3396: 
                   3397:     @pscat = @temp_pscat;
                   3398: 
1.548     raeburn  3399: 
1.209     www      3400:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3401: # ----------------------------------------------------------------- Start Table
1.57      albertel 3402:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3403:         my $csuname=$env{'user.name'};
                   3404:         my $csudom=$env{'user.domain'};
1.568     raeburn  3405:         my $readonly = 1;
                   3406:         if ($parm_permission->{'edit'}) {
                   3407:             undef($readonly); 
                   3408:         }
1.57      albertel 3409: 
1.203     www      3410:         if ($parmlev eq 'full') {
1.506     www      3411: #
                   3412: # This produces the cascading table output of parameters
                   3413: #
1.578     raeburn  3414:             my $coursespan=$csec?8:5;
                   3415:             my $userspan=3;
1.560     damieng  3416:             if ($cgroup ne '') {
1.578     raeburn  3417:                 $coursespan += 3;
1.560     damieng  3418:             }
1.473     amueller 3419: 
1.560     damieng  3420:             $r->print(&Apache::loncommon::start_data_table());
                   3421:             #
                   3422:             # This produces the headers
                   3423:             #
                   3424:             $r->print('<tr><td colspan="5"></td>');
                   3425:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3426:             if ($uname) {
1.473     amueller 3427:                 if (@usersgroups > 1) {
1.560     damieng  3428:                     $userspan ++;
                   3429:                 }
                   3430:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3431:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3432:             }
                   3433:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3434:                 'pie'    => "Parameter in Effect",
                   3435:                 'csv'    => "Current Session Value",
1.472     amueller 3436:                 'rl'     => "Resource Level",
1.473     amueller 3437:                 'ic'     => 'in Course',
                   3438:                 'aut'    => "Assessment URL and Title",
                   3439:                 'type'   => 'Type',
                   3440:                 'emof'   => "Enclosing Map or Folder",
                   3441:                 'part'   => 'Part',
1.472     amueller 3442:                 'pn'     => 'Parameter Name',
1.473     amueller 3443:                 'def'    => 'default',
                   3444:                 'femof'  => 'from Enclosing Map or Folder',
                   3445:                 'gen'    => 'general',
                   3446:                 'foremf' => 'for Enclosing Map or Folder',
                   3447:                 'fr'     => 'for Resource'
                   3448:             );
1.560     damieng  3449:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3450: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3451: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3452: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3453: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3454: 
1.10      www      3455: ENDTABLETWO
1.560     damieng  3456:             if ($csec) {
1.578     raeburn  3457:                 $r->print('<th colspan="3">'.
1.560     damieng  3458:                 &mt("in Section")." $csec</th>");
                   3459:             }
                   3460:             if ($cgroup) {
1.578     raeburn  3461:                 $r->print('<th colspan="3">'.
1.472     amueller 3462:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3463:             }
                   3464:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3465: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3466: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3467: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3468: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3469: ENDTABLEHEADFOUR
1.57      albertel 3470: 
1.560     damieng  3471:             if ($csec) {
1.578     raeburn  3472:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3473:             }
1.473     amueller 3474: 
1.560     damieng  3475:             if ($cgroup) {
1.578     raeburn  3476:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3477:             }
                   3478: 
                   3479:             if ($uname) {
                   3480:                 if (@usersgroups > 1) {
                   3481:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3482:                 }
1.578     raeburn  3483:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3484:             }
                   3485: 
                   3486:             $r->print('</tr>');
1.506     www      3487: #
                   3488: # Done with the headers
                   3489: # 
1.560     damieng  3490:             my $defbgone='';
                   3491:             my $defbgtwo='';
                   3492:             my $defbgthree = '';
1.57      albertel 3493: 
1.560     damieng  3494:             foreach my $rid (@ids) {
1.57      albertel 3495: 
                   3496:                 my ($inmapid)=($rid=~/\.(\d+)$/);
1.446     bisitz   3497:                 if ((!$pssymb &&
1.560     damieng  3498:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3499:                         ||
                   3500:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3501: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3502:                     if ($defbgone eq '#E0E099') {
                   3503:                         $defbgone='#E0E0DD';
1.57      albertel 3504:                     } else {
1.419     bisitz   3505:                         $defbgone='#E0E099';
1.57      albertel 3506:                     }
1.419     bisitz   3507:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3508:                         $defbgtwo='#FFFFDD';
1.57      albertel 3509:                     } else {
1.473     amueller 3510:                         $defbgtwo='#FFFF99';
1.57      albertel 3511:                     }
1.419     bisitz   3512:                     if ($defbgthree eq '#FFBB99') {
                   3513:                         $defbgthree='#FFBBDD';
1.269     raeburn  3514:                     } else {
1.419     bisitz   3515:                         $defbgthree='#FFBB99';
1.269     raeburn  3516:                     }
                   3517: 
1.57      albertel 3518:                     my $thistitle='';
                   3519:                     my %name=   ();
                   3520:                     undef %name;
                   3521:                     my %part=   ();
                   3522:                     my %display=();
                   3523:                     my %type=   ();
                   3524:                     my %default=();
1.196     www      3525:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3526:                     my $toolsymb;
                   3527:                     if ($uri =~ /ext\.tool$/) {
                   3528:                         $toolsymb = $symbp{$rid};
                   3529:                     }
1.57      albertel 3530: 
1.506     www      3531:                     my $filter=$env{'form.filter'};
1.548     raeburn  3532:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3533:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.584     raeburn  3534:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name',$toolsymb);
1.560     damieng  3535:     # We may only want certain parameters listed
                   3536:                             if ($filter) {
                   3537:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3538:                             }
                   3539:                             $name{$tempkeyp}=$parmname;
1.584     raeburn  3540:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part',$toolsymb);
1.560     damieng  3541: 
1.584     raeburn  3542:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display',$toolsymb);
1.560     damieng  3543:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3544:                                 my $identifier;
                   3545:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3546:                                     $identifier = $1;
                   3547:                                 }
                   3548:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3549:                             } else {
                   3550:                                 $display{$tempkeyp} = $parmdis;
                   3551:                             }
                   3552:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3553:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.584     raeburn  3554:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp,$toolsymb);
                   3555:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type',$toolsymb);
                   3556:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title',$toolsymb);
1.57      albertel 3557:                         }
                   3558:                     }
1.548     raeburn  3559:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3560:                     if ($totalparms>0) {
1.560     damieng  3561:                         my $firstrow=1;
1.473     amueller 3562:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.582     raeburn  3563:                         my $navmap = Apache::lonnavmaps::navmap->new();
                   3564:                         my @recurseup;
                   3565:                         if (ref($navmap) && $mapp{$rid}) {
                   3566:                             @recurseup = $navmap->recurseup_maps($mapp{$rid});
                   3567:                         }
1.419     bisitz   3568:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3569:                              ' rowspan='.$totalparms.
1.419     bisitz   3570:                              '><tt><font size="-1">'.
1.57      albertel 3571:                              join(' / ',split(/\//,$uri)).
                   3572:                              '</font></tt><p><b>'.
1.154     albertel 3573:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3574:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3575:                           &escape($symbp{$rid}).
1.336     albertel 3576:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3577:                              " target=\"_self\">$title");
1.57      albertel 3578: 
                   3579:                         if ($thistitle) {
1.473     amueller 3580:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3581:                         }
                   3582:                         $r->print('</a></b></td>');
1.419     bisitz   3583:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3584:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3585:                                       '</td>');
                   3586: 
1.419     bisitz   3587:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3588:                                       ' rowspan='.$totalparms.
1.238     www      3589:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3590:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3591:                             unless ($firstrow) {
                   3592:                                 $r->print('<tr>');
                   3593:                             } else {
                   3594:                                 undef $firstrow;
                   3595:                             }
1.548     raeburn  3596:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3597:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3598:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.582     raeburn  3599:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly,
                   3600:                                        \@recurseup,\%maptitles,\%allmaps_inverted,
                   3601:                                        \$numreclinks);
1.57      albertel 3602:                         }
                   3603:                     }
                   3604:                 }
                   3605:             } # end foreach ids
1.43      albertel 3606: # -------------------------------------------------- End entry for one resource
1.517     www      3607:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3608:         } # end of  full
1.57      albertel 3609: #--------------------------------------------------- Entry for parm level map
                   3610:         if ($parmlev eq 'map') {
1.419     bisitz   3611:             my $defbgone = '#E0E099';
                   3612:             my $defbgtwo = '#FFFF99';
                   3613:             my $defbgthree = '#FFBB99';
1.57      albertel 3614: 
                   3615:             my %maplist;
                   3616: 
                   3617:             if ($pschp eq 'all') {
1.446     bisitz   3618:                 %maplist = %allmaps;
1.57      albertel 3619:             } else {
                   3620:                 %maplist = ($pschp => $mapp{$pschp});
                   3621:             }
                   3622: 
                   3623: #-------------------------------------------- for each map, gather information
                   3624:             my $mapid;
1.560     damieng  3625:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3626:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3627: 
                   3628: #-----------------------  loop through ids and get all parameter types for map
                   3629: #-----------------------------------------          and associated information
                   3630:                 my %name = ();
                   3631:                 my %part = ();
                   3632:                 my %display = ();
                   3633:                 my %type = ();
                   3634:                 my %default = ();
                   3635:                 my $map = 0;
                   3636: 
1.473     amueller 3637: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3638: 
1.548     raeburn  3639:                 foreach my $id (@ids) {
                   3640:                     ($map)=($id =~ /([\d]*?)\./);
                   3641:                     my $rid = $id;
1.446     bisitz   3642: 
1.57      albertel 3643: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3644: 
1.560     damieng  3645:                     if ($map eq $mapid) {
1.473     amueller 3646:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3647:                         my $toolsymb;
                   3648:                         if ($uri =~ /ext\.tool$/) {
                   3649:                             $toolsymb = $symbp{$rid};
                   3650:                         }
1.582     raeburn  3651: 
1.57      albertel 3652: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3653: 
                   3654: #--------------------------------------------------------------------
                   3655: # @catmarker contains list of all possible parameters including part #s
                   3656: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3657: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3658: # When storing information, store as part 0
                   3659: # When requesting information, request from full part
                   3660: #-------------------------------------------------------------------
1.548     raeburn  3661:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3662:                             my $tempkeyp = $fullkeyp;
                   3663:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3664: 
1.548     raeburn  3665:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3666:                                 $part{$tempkeyp}="0";
1.584     raeburn  3667:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3668:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3669:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3670:                                     my $identifier;
                   3671:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3672:                                         $identifier = $1;
                   3673:                                     }
                   3674:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3675:                                 } else {
                   3676:                                     $display{$tempkeyp} = $parmdis;
                   3677:                                 }
                   3678:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3679:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3680:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3681:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3682:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.473     amueller 3683:                               }
                   3684:                         } # end loop through keys
1.560     damieng  3685:                     }
1.57      albertel 3686:                 } # end loop through ids
1.446     bisitz   3687: 
1.57      albertel 3688: #---------------------------------------------------- print header information
1.133     www      3689:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3690:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3691:                 my $tmp="";
1.57      albertel 3692:                 if ($uname) {
1.473     amueller 3693:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3694:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3695:                         &mt('in')." \n";
1.57      albertel 3696:                 } else {
1.401     bisitz   3697:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3698:                 }
1.269     raeburn  3699:                 if ($cgroup) {
1.401     bisitz   3700:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3701:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3702:                     $csec = '';
                   3703:                 } elsif ($csec) {
1.401     bisitz   3704:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3705:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3706:                 }
1.401     bisitz   3707:                 $r->print('<div align="center"><h4>'
                   3708:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3709:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3710:                              ,$tmp
                   3711:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3712:                              )
                   3713:                          ."<br /></h4>\n"
1.422     bisitz   3714:                 );
1.57      albertel 3715: #---------------------------------------------------------------- print table
1.419     bisitz   3716:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3717:                          .&Apache::loncommon::start_data_table_header_row()
                   3718:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3719:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3720:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3721:                          .&Apache::loncommon::end_data_table_header_row()
                   3722:                 );
1.57      albertel 3723: 
1.582     raeburn  3724:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   3725:                 my @recurseup;
                   3726:                 if (ref($navmap)) {
                   3727:                      my $mapres = $navmap->getByMapPc($mapid);
                   3728:                      if (ref($mapres)) {
                   3729:                          @recurseup = $navmap->recurseup_maps($mapres->src());
                   3730:                      }
                   3731:                 }
                   3732: 
                   3733: 
1.548     raeburn  3734:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3735:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3736:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3737:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3738:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
1.582     raeburn  3739:                            $readonly,\@recurseup,\%maptitles,\%allmaps_inverted,
                   3740:                            \$numreclinks);
1.57      albertel 3741:                 }
1.422     bisitz   3742:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3743:                          .'</div>'
                   3744:                 );
1.57      albertel 3745:             } # end each map
                   3746:         } # end of $parmlev eq map
                   3747: #--------------------------------- Entry for parm level general (Course level)
                   3748:         if ($parmlev eq 'general') {
1.473     amueller 3749:             my $defbgone = '#E0E099';
1.419     bisitz   3750:             my $defbgtwo = '#FFFF99';
                   3751:             my $defbgthree = '#FFBB99';
1.57      albertel 3752: 
                   3753: #-------------------------------------------- for each map, gather information
                   3754:             my $mapid="0.0";
                   3755: #-----------------------  loop through ids and get all parameter types for map
                   3756: #-----------------------------------------          and associated information
                   3757:             my %name = ();
                   3758:             my %part = ();
                   3759:             my %display = ();
                   3760:             my %type = ();
                   3761:             my %default = ();
1.446     bisitz   3762: 
1.548     raeburn  3763:             foreach $id (@ids) {
                   3764:                 my $rid = $id;
1.446     bisitz   3765: 
1.196     www      3766:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3767:                 my $toolsymb;
                   3768:                 if ($uri =~ /ext\.tool$/) {
                   3769:                     $toolsymb = $symbp{$rid};
                   3770:                 }
1.57      albertel 3771: 
                   3772: #--------------------------------------------------------------------
                   3773: # @catmarker contains list of all possible parameters including part #s
                   3774: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3775: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3776: # When storing information, store as part 0
                   3777: # When requesting information, request from full part
                   3778: #-------------------------------------------------------------------
1.548     raeburn  3779:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3780:                     my $tempkeyp = $fullkeyp;
                   3781:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3782:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3783:                         $part{$tempkeyp}="0";
1.584     raeburn  3784:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3785:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3786:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3787:                             my $identifier;
                   3788:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3789:                                 $identifier = $1;
                   3790:                             }
                   3791:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3792:                         } else {
                   3793:                             $display{$tempkeyp} = $parmdis;
                   3794:                         }
                   3795:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3796:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3797:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3798:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3799:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.560     damieng  3800:                     }
1.57      albertel 3801:                 } # end loop through keys
                   3802:             } # end loop through ids
1.446     bisitz   3803: 
1.57      albertel 3804: #---------------------------------------------------- print header information
1.473     amueller 3805:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3806:             $r->print(<<ENDMAPONE);
1.419     bisitz   3807: <center>
                   3808: <h4>$setdef
1.135     albertel 3809: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3810: ENDMAPONE
                   3811:             if ($uname) {
1.473     amueller 3812:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3813:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3814:             } else {
1.135     albertel 3815:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3816:             }
1.446     bisitz   3817: 
1.135     albertel 3818:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3819:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3820:             $r->print("</h4>\n");
1.57      albertel 3821: #---------------------------------------------------------------- print table
1.419     bisitz   3822:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3823:                      .&Apache::loncommon::start_data_table_header_row()
                   3824:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3825:                      .'<th>'.&mt('Default Value').'</th>'
                   3826:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3827:                      .&Apache::loncommon::end_data_table_header_row()
                   3828:             );
1.57      albertel 3829: 
1.548     raeburn  3830:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3831:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3832:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3833:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3834:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3835:                            $readonly);
1.57      albertel 3836:             }
1.419     bisitz   3837:             $r->print(&Apache::loncommon::end_data_table()
                   3838:                      .'</p>'
                   3839:                      .'</center>'
                   3840:             );
1.57      albertel 3841:         } # end of $parmlev eq general
1.43      albertel 3842:     }
1.507     www      3843:     $r->print('</form>');
1.582     raeburn  3844:     if ($numreclinks) {
                   3845:         $r->print(<<"END");
                   3846: <form name="recurseform" action="/adm/parmset?action=settable" method="post">
                   3847: <input type="hidden" name="pschp" />
                   3848: <input type="hidden" name="pscat" />
                   3849: <input type="hidden" name="psprt" />
                   3850: <input type="hidden" name="hideparmsel" value="hidden" />
                   3851: </form>
                   3852: <script type="text/javascript">
                   3853: function pjumprec(rid,name,part) {
                   3854:     document.forms.recurseform.pschp.value = rid;
                   3855:     document.forms.recurseform.pscat.value = name;
                   3856:     document.forms.recurseform.psprt.value = part;
                   3857:     document.forms.recurseform.submit();
                   3858:     return false;
                   3859: }
                   3860: </script>
                   3861: END
                   3862:     }
1.507     www      3863:     &endSettingsScreen($r);
                   3864:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3865: } # end sub assessparms
1.30      www      3866: 
1.560     damieng  3867: 
                   3868: 
1.120     www      3869: ##################################################
1.560     damieng  3870: # OVERVIEW MODE
1.207     www      3871: ##################################################
1.124     www      3872: 
1.563     damieng  3873: my $tableopen; # boolean, true if HTML table is already opened
                   3874: 
                   3875: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3876: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3877: # @returns {string}
1.124     www      3878: sub tablestart {
1.576     raeburn  3879:     my ($readonly,$is_map) = @_;
1.124     www      3880:     if ($tableopen) {
1.552     raeburn  3881:         return '';
1.124     www      3882:     } else {
1.552     raeburn  3883:         $tableopen=1;
                   3884:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3885:         if ($readonly) {
                   3886:             $output .= '<th>'.&mt('Current value').'</th>';
                   3887:         } else {
1.576     raeburn  3888:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3889:                        '<th>'.&mt('Set to ...').'</th>';
                   3890:             if ($is_map) {
                   3891:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3892:             }
1.552     raeburn  3893:         }
                   3894:         $output .= '</tr>';
                   3895:         return $output;
1.124     www      3896:     }
                   3897: }
                   3898: 
1.563     damieng  3899: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3900: # @returns {string}
1.124     www      3901: sub tableend {
                   3902:     if ($tableopen) {
1.560     damieng  3903:         $tableopen=0;
                   3904:         return &Apache::loncommon::end_data_table();
1.124     www      3905:     } else {
1.560     damieng  3906:         return'';
1.124     www      3907:     }
                   3908: }
                   3909: 
1.563     damieng  3910: # Reads course and user information.
                   3911: # 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).
                   3912: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3913: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3914: # @param {string} $crs - course number
                   3915: # @param {string} $dom - course domain
                   3916: # @returns {hash reference|Array}
1.207     www      3917: sub readdata {
                   3918:     my ($crs,$dom)=@_;
                   3919: # Read coursedata
                   3920:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3921: # Read userdata
                   3922: 
                   3923:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3924:     foreach my $user (keys(%$classlist)) {
                   3925:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3926:             my ($tuname,$tudom)=($1,$2);
                   3927:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3928:             foreach my $userkey (keys(%{$useropt})) {
                   3929:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3930:                     my $newkey=$userkey;
1.548     raeburn  3931:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3932:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3933:                 }
                   3934:             }
1.473     amueller 3935:         }
                   3936:     }
1.552     raeburn  3937:     if (wantarray) {
                   3938:         return ($resourcedata,$classlist);
                   3939:     } else {
                   3940:         return $resourcedata;
                   3941:     }
1.207     www      3942: }
                   3943: 
                   3944: 
1.563     damieng  3945: # Stores parameter data, using form parameters directly.
                   3946: #
                   3947: # 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  3948: # set_* (except settext, setipallow, setipdeny, setdeeplink) - set a parameter value
1.563     damieng  3949: # del_* - remove a parameter
                   3950: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3951: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3952: # key_* - date values
                   3953: # days_* - for date intervals
                   3954: # hours_* - for date intervals
                   3955: # minutes_* - for date intervals
                   3956: # seconds_* - for date intervals
                   3957: # done_* - for date intervals
                   3958: # typeof_* - parameter type
                   3959: # 
                   3960: # @param {Apache2::RequestRec} $r - the Apache request
                   3961: # @param {string} $crs - course number
                   3962: # @param {string} $dom - course domain
1.208     www      3963: sub storedata {
                   3964:     my ($r,$crs,$dom)=@_;
1.207     www      3965: # Set userlevel immediately
                   3966: # Do an intermediate store of course level
                   3967:     my $olddata=&readdata($crs,$dom);
1.124     www      3968:     my %newdata=();
                   3969:     undef %newdata;
                   3970:     my @deldata=();
1.576     raeburn  3971:     my @delrec=();
                   3972:     my @delnonrec=();
1.124     www      3973:     undef @deldata;
1.504     raeburn  3974:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3975:     my $now = time;
1.560     damieng  3976:     foreach my $key (keys(%env)) {
                   3977:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3978:             my $cmd=$1;
                   3979:             my $thiskey=$2;
1.576     raeburn  3980:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
1.588     raeburn  3981:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny' || $cmd eq 'setdeeplink');
1.576     raeburn  3982:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3983:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3984:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3985:                     $altkey = $thiskey;
                   3986:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   3987:                     if ($env{'form.rec_'.$thiskey}) {
                   3988:                         $recursive = 1;
                   3989:                     }
                   3990:                 }
                   3991:             }
1.560     damieng  3992:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 3993:             if ($tuname) {
1.576     raeburn  3994:                 $tkey=$thiskey;
1.560     damieng  3995:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  3996:                 if ($altkey) {
                   3997:                     $tkeynonrec = $tkey; 
                   3998:                     $tkeyrec = $altkey;
                   3999:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   4000:                 }
1.560     damieng  4001:             }
                   4002:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  4003:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   4004:                 if ($cmd eq 'set') {
                   4005:                     $data=$env{$key};
                   4006:                     $valmatch = '';
                   4007:                     $valchk = $data;
                   4008:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4009:                     $text = &mt('Saved modified parameter for');
                   4010:                     if ($typeof eq 'string_questiontype') {
                   4011:                         $name = 'type';
1.588     raeburn  4012:                     } elsif (($typeof eq 'string_lenient') || ($typeof eq 'string_deeplink')) {
                   4013:                         ($name) = ($typeof =~ /^string_(lenient|deeplink)$/);
1.563     damieng  4014:                         my $stringmatch = &standard_string_matches($typeof);
                   4015:                         if (ref($stringmatch) eq 'ARRAY') {
                   4016:                             foreach my $item (@{$stringmatch}) {
                   4017:                                 if (ref($item) eq 'ARRAY') {
                   4018:                                     my ($regexpname,$pattern) = @{$item};
                   4019:                                     if ($pattern ne '') {
                   4020:                                         if ($data =~ /$pattern/) {
                   4021:                                             $valmatch = $regexpname;
                   4022:                                             $valchk = '';
                   4023:                                             last;
                   4024:                                         }
1.560     damieng  4025:                                     }
1.549     raeburn  4026:                                 }
                   4027:                             }
                   4028:                         }
1.563     damieng  4029:                     } elsif ($typeof eq 'string_discussvote') {
                   4030:                         $name = 'discussvote';
                   4031:                     } elsif ($typeof eq 'string_examcode') {
                   4032:                         $name = 'examcode';
                   4033:                         if (&Apache::lonnet::validCODE($data)) {
                   4034:                             $valchk = 'valid';
                   4035:                         }
                   4036:                     } elsif ($typeof eq 'string_yesno') {
                   4037:                         if ($thiskey =~ /\.retrypartial$/) {
                   4038:                             $name = 'retrypartial';
                   4039:                         }
1.549     raeburn  4040:                     }
1.563     damieng  4041:                 } elsif ($cmd eq 'datepointer') {
                   4042:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   4043:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4044:                     $text = &mt('Saved modified date for');
                   4045:                     if ($typeof eq 'date_start') {
                   4046:                         if ($thiskey =~ /\.printstartdate$/) {
                   4047:                             $name = 'printstartdate';
                   4048:                             if (($data) && ($data > $now)) {
                   4049:                                 $valchk = 'future';
                   4050:                             }
1.560     damieng  4051:                         }
1.563     damieng  4052:                     } elsif ($typeof eq 'date_end') {
                   4053:                         if ($thiskey =~ /\.printenddate$/) {
                   4054:                             $name = 'printenddate';
                   4055:                             if (($data) && ($data < $now)) {
                   4056:                                 $valchk = 'past';
                   4057:                             }
1.560     damieng  4058:                         }
1.504     raeburn  4059:                     }
1.563     damieng  4060:                 } elsif ($cmd eq 'dateinterval') {
                   4061:                     $data=&get_date_interval_from_form($thiskey);
                   4062:                     if ($thiskey =~ /\.interval$/) {
                   4063:                         $name = 'interval';
                   4064:                         my $intervaltype = &get_intervaltype($name);
                   4065:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   4066:                         if (ref($intervalmatch) eq 'ARRAY') {
                   4067:                             foreach my $item (@{$intervalmatch}) {
                   4068:                                 if (ref($item) eq 'ARRAY') {
                   4069:                                     my ($regexpname,$pattern) = @{$item};
                   4070:                                     if ($pattern ne '') {
                   4071:                                         if ($data =~ /$pattern/) {
                   4072:                                             $valmatch = $regexpname;
                   4073:                                             $valchk = '';
                   4074:                                             last;
                   4075:                                         }
1.560     damieng  4076:                                     }
1.554     raeburn  4077:                                 }
                   4078:                             }
                   4079:                         }
                   4080:                     }
1.563     damieng  4081:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4082:                     $text = &mt('Saved modified date for');
1.554     raeburn  4083:                 }
1.576     raeburn  4084:                 if ($recursive) {
1.563     damieng  4085:                     $namematch = 'maplevelrecurse';
1.560     damieng  4086:                 }
1.563     damieng  4087:                 if (($name ne '') || ($namematch ne '')) {
                   4088:                     my ($needsrelease,$needsnewer);
                   4089:                     if ($name ne '') {
                   4090:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  4091:                         if ($needsrelease) {
                   4092:                             unless ($got_chostname) {
1.563     damieng  4093:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  4094:                                 $got_chostname = 1;
                   4095:                             }
1.563     damieng  4096:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   4097:                                                                 $needsrelease,
                   4098:                                                                 $cmajor,$cminor);
                   4099:                         }
                   4100:                     }
                   4101:                     if ($namematch ne '') {
                   4102:                         if ($needsnewer) {
                   4103:                             undef($namematch);
1.560     damieng  4104:                         } else {
1.563     damieng  4105:                             my $currneeded;
                   4106:                             if ($needsrelease) {
                   4107:                                 $currneeded = $needsrelease;
                   4108:                             }
                   4109:                             $needsrelease =
                   4110:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   4111:                             if (($needsrelease) &&
                   4112:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   4113:                                 unless ($got_chostname) {
                   4114:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   4115:                                     $got_chostname = 1;
                   4116:                                 }
                   4117:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   4118:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   4119:                             } else {
                   4120:                                 undef($namematch);
                   4121:                             }
1.560     damieng  4122:                         }
1.557     raeburn  4123:                     }
1.563     damieng  4124:                     if ($needsnewer) {
                   4125:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   4126:                                                             $chostname,$cmajor,
                   4127:                                                             $cminor,$needsrelease));
                   4128:                         next;
                   4129:                     }
1.504     raeburn  4130:                 }
1.576     raeburn  4131:                 my ($reconlychg,$haschange,$storekey);
                   4132:                 if ($tuname) {
                   4133:                     my $ustorekey;
                   4134:                     if ($altkey) {
                   4135:                         if ($recursive) {
                   4136:                             if (exists($$olddata{$thiskey})) {
                   4137:                                 if ($$olddata{$thiskey} eq $data) {
                   4138:                                     $reconlychg = 1;
                   4139:                                 }
                   4140:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   4141:                             }
                   4142:                             if (exists($$olddata{$altkey})) {
                   4143:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4144:                                     $haschange = 1;
                   4145:                                 }
                   4146:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4147:                                 $haschange = 1;
                   4148:                             }
                   4149:                             $ustorekey = $tkeyrec;
                   4150:                         } else {
                   4151:                             if (exists($$olddata{$altkey})) {
                   4152:                                 if ($$olddata{$altkey} eq $data) {
                   4153:                                     $reconlychg = 1;
                   4154:                                 }
                   4155:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   4156:                             }
                   4157:                             if (exists($$olddata{$thiskey})) {
                   4158:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4159:                                     $haschange = 1;
                   4160:                                 }
                   4161:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4162:                                 $haschange = 1;
                   4163:                             }
                   4164:                             $ustorekey = $tkeynonrec;
                   4165:                         }
                   4166:                     } else {
                   4167:                         if (exists($$olddata{$tkey})) {
                   4168:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   4169:                                 $haschange = 1;
                   4170:                             }
                   4171:                             $ustorekey = $tkey;
                   4172:                         }
                   4173:                     }
                   4174:                     if ($haschange || $reconlychg)  {
                   4175:                         unless ($env{'form.del_'.$thiskey}) {
                   4176:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   4177:                                                                      $ustorekey.'.type' => $typeof},
                   4178:                                                                      $tudom,$tuname) eq 'ok') {
                   4179:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   4180:                                 $r->print('<br />'.$text.' '.
                   4181:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   4182:                             } else {
                   4183:                                 $r->print('<div class="LC_error">'.
                   4184:                                           &mt('Error saving parameters').'</div>');
                   4185:                             }
                   4186:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4187:                         }
                   4188:                     }
                   4189:                 } else {
                   4190:                     if ($altkey) {
                   4191:                         if ($recursive) {
                   4192:                             if (exists($$olddata{$thiskey})) {
                   4193:                                 if ($$olddata{$thiskey} eq $data) {
                   4194:                                     $reconlychg = 1;
                   4195:                                 }
                   4196:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   4197:                             }
                   4198:                             if (exists($$olddata{$altkey})) {
                   4199:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4200:                                     $haschange = 1;
                   4201:                                 }
                   4202:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4203:                                 $haschange = 1;
                   4204:                             }
                   4205:                             $storekey = $altkey;
1.563     damieng  4206:                         } else {
1.576     raeburn  4207:                             if (exists($$olddata{$altkey})) {
                   4208:                                 if ($$olddata{$altkey} eq $data) {
                   4209:                                     $reconlychg = 1;
                   4210:                                 }
                   4211:                                 push(@delrec,($altkey,$altkey.'.type'));
                   4212:                             } 
                   4213:                             if (exists($$olddata{$thiskey})) {
                   4214:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4215:                                     $haschange = 1;
                   4216:                                 }
                   4217:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4218:                                 $haschange = 1;
                   4219:                             }
                   4220:                             $storekey = $thiskey;
1.563     damieng  4221:                         }
1.560     damieng  4222:                     } else {
1.576     raeburn  4223:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4224:                             $haschange = 1;
                   4225:                             $storekey = $thiskey;
                   4226:                         }
                   4227:                     }
                   4228:                 }
                   4229:                 if ($reconlychg || $haschange) {
                   4230:                     unless ($env{'form.del_'.$thiskey}) {
                   4231:                         $newdata{$storekey}=$data;
                   4232:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  4233:                     }
                   4234:                 }
                   4235:             } elsif ($cmd eq 'del') {
                   4236:                 if ($tuname) {
1.576     raeburn  4237:                     my $error;
                   4238:                     if ($altkey) {  
                   4239:                         if (exists($$olddata{$altkey})) {
                   4240:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4241:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   4242:                                 if ($recursive) {
                   4243:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4244:                                 }
                   4245:                             } elsif ($recursive) {
                   4246:                                 $error = 1;
                   4247:                             }
                   4248:                         }
                   4249:                         if (exists($$olddata{$thiskey})) {
                   4250:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4251:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   4252:                                 unless ($recursive) {
                   4253:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4254:                                 }
                   4255:                             } elsif (!$recursive) {
                   4256:                                 $error = 1;
                   4257:                             }
                   4258:                         }
1.560     damieng  4259:                     } else {
1.576     raeburn  4260:                         if (exists($$olddata{$thiskey})) {
                   4261:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   4262:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   4263:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4264:                             } else {
                   4265:                                 $error = 1;
                   4266:                             }
                   4267:                         }
                   4268:                     }
                   4269:                     if ($error) { 
1.560     damieng  4270:                         $r->print('<div class="LC_error">'.
                   4271:                             &mt('Error deleting parameters').'</div>');
                   4272:                     }
                   4273:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4274:                 } else {
1.576     raeburn  4275:                     if ($altkey) {
                   4276:                         if (exists($$olddata{$altkey})) {
                   4277:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   4278:                                 push(@deldata,($altkey,$altkey.'.type'));
                   4279:                             }
                   4280:                         }
                   4281:                         if (exists($$olddata{$thiskey})) {
                   4282:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   4283:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   4284:                             }
                   4285:                         }
                   4286:                     } elsif (exists($$olddata{$thiskey})) {
                   4287:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   4288:                     }
1.560     damieng  4289:                 }
1.473     amueller 4290:             }
                   4291:         }
                   4292:     }
1.207     www      4293: # Store all course level
1.144     www      4294:     my $delentries=$#deldata+1;
1.576     raeburn  4295:     my @alldels;
                   4296:     if (@delrec) {
                   4297:         push(@alldels,@delrec);
                   4298:     }
                   4299:     if (@delnonrec) {
                   4300:         push(@alldels,@delnonrec);
                   4301:     }
                   4302:     if (@deldata) {
                   4303:         push(@alldels,@deldata);
                   4304:     }
1.548     raeburn  4305:     my @newdatakeys=keys(%newdata);
1.144     www      4306:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4307:     my ($delresult,$devalidate);
                   4308:     if (@alldels) {
                   4309:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4310:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4311:             &log_parmset(\%loghash,1);
1.576     raeburn  4312:             if ($delentries) {
                   4313:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4314:             }
                   4315:         } elsif ($delentries) {
1.560     damieng  4316:             $r->print('<div class="LC_error">'.
                   4317:                 &mt('Error deleting parameters').'</div>');
                   4318:         }
1.576     raeburn  4319:         $devalidate = 1; 
1.144     www      4320:     }
                   4321:     if ($putentries) {
1.560     damieng  4322:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4323:                     &log_parmset(\%newdata,0);
                   4324:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4325:         } else {
                   4326:             $r->print('<div class="LC_error">'.
                   4327:                 &mt('Error saving parameters').'</div>');
                   4328:         }
1.576     raeburn  4329:         $devalidate = 1; 
                   4330:     }
                   4331:     if ($devalidate) {
1.560     damieng  4332:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4333:     }
1.208     www      4334: }
1.207     www      4335: 
1.563     damieng  4336: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4337: #
                   4338: # @param {string} $key - the key
                   4339: # @returns {Array}
1.208     www      4340: sub extractuser {
                   4341:     my $key=shift;
1.350     albertel 4342:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4343: }
1.206     www      4344: 
1.563     damieng  4345: # Parses a parameter key and returns the components.
                   4346: #
                   4347: # @param {string} $key - 
                   4348: # @param {hash reference} $listdata - 
                   4349: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4350: sub parse_listdata_key {
                   4351:     my ($key,$listdata) = @_;
                   4352:     # split into student/section affected, and
                   4353:     # the realm (folder/resource part and parameter
1.446     bisitz   4354:     my ($student,$realm) =
1.473     amueller 4355:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4356:     # if course wide student would be undefined
                   4357:     if (!defined($student)) {
1.560     damieng  4358:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4359:     }
                   4360:     # strip off the .type if it's not the Question type parameter
                   4361:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4362:         $realm=~s/\.type//;
1.381     albertel 4363:     }
                   4364:     # split into resource+part and parameter name
1.388     albertel 4365:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4366:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4367:     return ($student,$res,$part,$parm);
                   4368: }
                   4369: 
1.563     damieng  4370: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4371: #
                   4372: # @param {Apache2::RequestRec} $r - the Apache request
                   4373: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4374: # @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
                   4375: # @param {string} $sortorder - realmstudent|studentrealm
                   4376: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4377: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4378: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4379: # @returns{integer} - number of $listdata parameters processed
1.208     www      4380: sub listdata {
1.568     raeburn  4381:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4382:     
1.207     www      4383: # Start list output
1.206     www      4384: 
1.122     www      4385:     my $oldsection='';
                   4386:     my $oldrealm='';
                   4387:     my $oldpart='';
1.123     www      4388:     my $pointer=0;
1.124     www      4389:     $tableopen=0;
1.145     www      4390:     my $foundkeys=0;
1.248     albertel 4391:     my %keyorder=&standardkeyorder();
1.381     albertel 4392: 
1.552     raeburn  4393:     my ($secidx,%grouphash);
                   4394:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4395:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4396:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4397:             %grouphash = &Apache::longroup::coursegroups();
                   4398:         } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  4399:             map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  4400:         }
1.552     raeburn  4401:     }
                   4402: 
1.576     raeburn  4403:     foreach my $key (sort {
1.560     damieng  4404:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4405:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4406: 
1.560     damieng  4407:         # get the numerical order for the param
                   4408:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4409:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4410: 
1.560     damieng  4411:         my $result=0;
1.381     albertel 4412: 
1.560     damieng  4413:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4414:             if ($ares     ne $bres    ) {
1.560     damieng  4415:                 $result = ($ares     cmp $bres);
1.446     bisitz   4416:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4417:                 $result = ($astudent cmp $bstudent);
                   4418:             } elsif ($apart    ne $bpart   ) {
                   4419:                 $result = ($apart    cmp $bpart);
                   4420:             }
                   4421:         } else {
                   4422:             if      ($astudent ne $bstudent) {
                   4423:                 $result = ($astudent cmp $bstudent);
                   4424:             } elsif ($ares     ne $bres    ) {
                   4425:                 $result = ($ares     cmp $bres);
                   4426:             } elsif ($apart    ne $bpart   ) {
                   4427:                 $result = ($apart    cmp $bpart);
                   4428:             }
1.473     amueller 4429:         }
1.446     bisitz   4430: 
1.560     damieng  4431:         if (!$result) {
1.381     albertel 4432:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4433:                 $result = ($aparm <=> $bparm);
1.381     albertel 4434:             } elsif (defined($aparm)) {
1.560     damieng  4435:                 $result = -1;
1.381     albertel 4436:             } elsif (defined($bparm)) {
1.560     damieng  4437:                 $result = 1;
                   4438:             }
1.473     amueller 4439:         }
1.381     albertel 4440: 
1.560     damieng  4441:         $result;
                   4442:         
1.576     raeburn  4443:     } keys(%{$listdata})) { # foreach my $key
                   4444:         my $thiskey = $key;
1.560     damieng  4445:         if ($$listdata{$thiskey.'.type'}) {
                   4446:             my $thistype=$$listdata{$thiskey.'.type'};
                   4447:             if ($$resourcedata{$thiskey.'.type'}) {
                   4448:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4449:             }
                   4450:             my ($middle,$part,$name)=
1.572     damieng  4451:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4452:             my $section=&mt('All Students');
1.576     raeburn  4453:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4454:             if ($middle=~/^\[(.*)\]/) {
                   4455:                 my $issection=$1;
                   4456:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4457:                     my ($stuname,$studom) = ($1,$2);
                   4458:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4459:                         if (ref($classlist) eq 'HASH') {
                   4460:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4461:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4462:                             }
                   4463:                         }
                   4464:                     }
                   4465:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4466:                 } else {
                   4467:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4468:                         if (exists($grouphash{$issection})) {
                   4469:                             $section=&mt('Group').': '.$issection;
                   4470:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4471:                             $section = &mt('Section').': '.$issection;
                   4472:                         } else {
                   4473:                             next; 
1.552     raeburn  4474:                         }
1.560     damieng  4475:                     } else {
                   4476:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4477:                     }
                   4478:                 }
1.560     damieng  4479:                 $middle=~s/^\[(.*)\]//;
                   4480:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4481:                 $readonly = 1;
                   4482:             }
                   4483:             $middle=~s/\.+$//;
                   4484:             $middle=~s/^\.+//;
                   4485:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4486:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4487:             if ($caller eq 'overview') {
                   4488:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4489:                     $mapurl = $1;
                   4490:                     $maplevel = $2;
                   4491:                     $is_map = 1;
                   4492:                 }
                   4493:             } elsif ($caller eq 'newoverview') {
                   4494:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4495:                     $mapurl = $1;
                   4496:                     $maplevel = $2;
                   4497:                     $is_map = 1;
                   4498:                 }
                   4499:             }
                   4500:             if ($is_map) {
1.560     damieng  4501:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4502:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4503:                     if ($caller eq 'newoverview') {
                   4504:                         my $altkey = $thiskey;
                   4505:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4506:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4507:                             $is_recursive = 1;
                   4508:                             if ($$resourcedata{$altkey.'.type'}) {
                   4509:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4510:                             }
                   4511:                             $showval = $$resourcedata{$altkey};
                   4512:                         }
                   4513:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4514:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4515:                         $is_recursive = 1;
                   4516:                     }
1.560     damieng  4517:                 }
                   4518:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4519:             } elsif ($middle) {
                   4520:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4521:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4522:                     ': '.&Apache::lonnet::gettitle($middle).
                   4523:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4524:                     $id.')</span></span>';
                   4525:             }
                   4526:             if ($sortorder eq 'realmstudent') {
                   4527:                 if ($realm ne $oldrealm) {
                   4528:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4529:                     $oldrealm=$realm;
                   4530:                     $oldsection='';
                   4531:                 }
                   4532:                 if ($section ne $oldsection) {
                   4533:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4534:                     $oldsection=$section;
                   4535:                     $oldpart='';
                   4536:                 }
1.552     raeburn  4537:             } else {
1.560     damieng  4538:                 if ($section ne $oldsection) {
                   4539:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4540:                     $oldsection=$section;
                   4541:                     $oldrealm='';
                   4542:                 }
                   4543:                 if ($realm ne $oldrealm) {
                   4544:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4545:                     $oldrealm=$realm;
                   4546:                     $oldpart='';
1.552     raeburn  4547:                 }
                   4548:             }
1.560     damieng  4549:             if ($part ne $oldpart) {
                   4550:                 $r->print(&tableend().
                   4551:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4552:                 $oldpart=$part;
1.556     raeburn  4553:             }
1.560     damieng  4554:     #
                   4555:     # Ready to print
                   4556:     #
1.470     raeburn  4557:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4558:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4559:                 &Apache::loncommon::start_data_table_row().
                   4560:                 '<td><b>'.&mt($parmitem).
                   4561:                 '</b></td>');
                   4562:             unless ($readonly) {
                   4563:                 $r->print('<td><input type="checkbox" name="del_'.
                   4564:                         $thiskey.'" /></td>');
                   4565:             }
                   4566:             $r->print('<td>');
                   4567:             $foundkeys++;
                   4568:             if (&isdateparm($thistype)) {
                   4569:                 my $jskey='key_'.$pointer;
                   4570:                 my $state;
                   4571:                 $pointer++;
                   4572:                 if ($readonly) {
                   4573:                     $state = 'disabled';
                   4574:                 }
                   4575:                 $r->print(
                   4576:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4577:                                                         $jskey,
1.576     raeburn  4578:                                                         $showval,
1.560     damieng  4579:                                                         '',1,$state));
                   4580:                 unless  ($readonly) {
                   4581:                     $r->print(
                   4582:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4583:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4584:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4585:     &date_sanity_info($showval)
1.560     damieng  4586:                     );
                   4587:                 }
                   4588:             } elsif ($thistype eq 'date_interval') {
                   4589:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4590:                           $showval,$readonly));
1.560     damieng  4591:             } elsif ($thistype =~ m/^string/) {
                   4592:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4593:                           $showval,$name,$readonly));
1.560     damieng  4594:             } else {
1.576     raeburn  4595:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4596:             }
1.560     damieng  4597:             unless ($readonly) {
                   4598:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4599:                         $thistype.'" />');
1.552     raeburn  4600:             }
1.576     raeburn  4601:             $r->print('</td>');
                   4602:             if ($is_map) {
                   4603:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4604:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4605:                 } else {
                   4606:                     my ($disabled,$recon,$recoff);
                   4607:                     if ($readonly) {
                   4608:                         $disabled = ' disabled="disabled"';
                   4609:                     }
                   4610:                     if ($is_recursive) {
                   4611:                         $recon = ' checked="checked"';
                   4612:                     } else {
                   4613:                         $recoff = ' checked="checked"';
                   4614:                     }
                   4615:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4616:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4617:                 }
                   4618:             }
                   4619:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4620:         }
1.121     www      4621:     }
1.208     www      4622:     return $foundkeys;
                   4623: }
                   4624: 
1.563     damieng  4625: # Returns a string representing the interval, directly using form data matching the given key.
                   4626: # The returned string may also include information related to proctored exams.
                   4627: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4628: #
                   4629: # @param {string} $key - suffix for form fields related to the interval
                   4630: # @returns {string}
1.385     albertel 4631: sub get_date_interval_from_form {
                   4632:     my ($key) = @_;
                   4633:     my $seconds = 0;
                   4634:     foreach my $which (['days', 86400],
1.473     amueller 4635:                ['hours', 3600],
                   4636:                ['minutes', 60],
                   4637:                ['seconds',  1]) {
1.560     damieng  4638:         my ($name, $factor) = @{ $which };
                   4639:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4640:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4641:         }
1.473     amueller 4642:     }
1.560     damieng  4643:     if (($key =~ /\.interval$/) &&
                   4644:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4645:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4646:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4647:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4648:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4649:                 $seconds .= '_proctor';
                   4650:             }
                   4651:         } else {
                   4652:             $seconds .= $env{'form.done_'.$key}; 
                   4653:         }
                   4654:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4655:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4656:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4657:         }
1.554     raeburn  4658:     }
1.385     albertel 4659:     return $seconds;
                   4660: }
                   4661: 
                   4662: 
1.563     damieng  4663: # Returns HTML to enter a text value for a parameter.
                   4664: #
                   4665: # @param {string} $thiskey - parameter key
                   4666: # @param {string} $showval - the current value
                   4667: # @param {boolean} $readonly - true if the field should not be made editable
                   4668: # @returns {string}
1.383     albertel 4669: sub default_selector {
1.552     raeburn  4670:     my ($thiskey, $showval, $readonly) = @_;
                   4671:     my $disabled;
                   4672:     if ($readonly) {
                   4673:         $disabled = ' disabled="disabled"';
                   4674:     }
                   4675:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4676: }
                   4677: 
1.563     damieng  4678: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4679: #
                   4680: # @param {string} $thiskey - parameter key
                   4681: # @param {string} $showval - the current value
                   4682: # @param {boolean} $readonly - true if the fields should not be made editable
                   4683: # @returns {string}
1.549     raeburn  4684: sub string_ip_selector {
1.552     raeburn  4685:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4686:     my %access = (
                   4687:                    allow => [],
                   4688:                    deny  => [],
                   4689:                  );
                   4690:     if ($showval ne '') {
                   4691:         my @current;
                   4692:         if ($showval =~ /,/) {
                   4693:             @current = split(/,/,$showval);
                   4694:         } else {
                   4695:             @current = ($showval);
                   4696:         }
                   4697:         foreach my $item (@current) {
                   4698:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4699:                 push(@{$access{'deny'}},$1);
                   4700:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4701:                 push(@{$access{'allow'}},$item);
                   4702:             }
                   4703:         }
                   4704:     }
                   4705:     if (!@{$access{'allow'}}) {
                   4706:         @{$access{'allow'}} = ('');
                   4707:     }
                   4708:     if (!@{$access{'deny'}}) {
                   4709:         @{$access{'deny'}} = ('');
                   4710:     }
1.552     raeburn  4711:     my ($disabled,$addmore);
1.567     raeburn  4712:     if ($readonly) {
1.552     raeburn  4713:         $disabled=' disabled="disabled"';
                   4714:     } else {
                   4715:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4716:     }
1.549     raeburn  4717:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4718: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4719:     foreach my $acctype ('allow','deny') {
                   4720:         $output .= '
                   4721: <td valign="top">
                   4722: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4723:   <div class="LC_string_ipacc_inner">'."\n";
                   4724:         my $num = 0;
                   4725:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4726:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4727:             if ($num > 0) {
                   4728:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4729:             }
                   4730:             $output .= '</div>'."\n";
                   4731:             $num ++;
                   4732:         }
                   4733:         $output .= '
1.552     raeburn  4734:   </div>'.$addmore.'
1.549     raeburn  4735: </div>
                   4736: </td>';
                   4737:    }
                   4738:    $output .= '
                   4739: </tr>
                   4740: </table>'."\n";
                   4741:     return $output;
                   4742: }
                   4743: 
1.588     raeburn  4744: sub string_deeplink_selector {
                   4745:     my ($thiskey, $showval, $readonly) = @_;
                   4746:     my (@components,%values,@current,%titles,%options,%optiontext,%defaults,%posslti);
                   4747:     @components = ('listing','scope','urls');
                   4748:     %titles = &Apache::lonlocal::texthash (
                   4749:                   listing => 'In Contents and/or Gradebook',
                   4750:                   scope   => 'Access scope for link',
                   4751:                   urls    => 'Supported link types',
                   4752:               );
                   4753:     %options = (
                   4754:                    listing => ['full','absent','grades','details','datestatus'],
                   4755:                    scope   => ['res','map','rec'],
                   4756:                    urls    => ['any','only','key','lti'],
                   4757:                );
                   4758:     %optiontext = &Apache::lonlocal::texthash (
                   4759:                     full       => 'Listed (linked) in both',
                   4760:                     absent     => 'Not listed',
                   4761:                     grades     => 'Listed in grades only',
                   4762:                     details    => 'Listed (unlinked) in both',
                   4763:                     datestatus => 'Listed (unlinked) inc. status in both',
                   4764:                     res        => 'resource only',
                   4765:                     map        => 'enclosing map/folder',
                   4766:                     rec        => 'recursive map/folder',
                   4767:                     any        => 'regular + deep',
                   4768:                     only       => 'deep only',
                   4769:                     key        => 'deep with key',
                   4770:                     lti        => 'deep with LTI launch',
                   4771:                   );
                   4772:     if ($showval =~ /,/) {
                   4773:         @current = split(/,/,$showval);
                   4774:         ($values{'listing'}) = ($current[0] =~ /^(full|absent|grades|details|datestatus)$/);
                   4775:         ($values{'scope'}) = ($current[1] =~ /^(res|map|rec)$/);
                   4776:         ($values{'urls'}) = ($current[2] =~ /^(any|only|key:\w+|lti:\d+)$/);
                   4777:     } else {
                   4778:         $defaults{'listing'} = 'full';
                   4779:         $defaults{'scope'} = 'res';
                   4780:         $defaults{'urls'} = 'any';
                   4781:     }
                   4782:     my $disabled;
                   4783:     if ($readonly) {
                   4784:         $disabled=' disabled="disabled"';
                   4785:     }
                   4786:     my %lti = 
                   4787:         &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   4788:                                         'provider');
                   4789:     foreach my $item (keys(%lti)) {
                   4790:         if (ref($lti{$item}) eq 'HASH') {
                   4791:             unless ($lti{$item}{'requser'}) {
                   4792:                 $posslti{$item} = $lti{$item}{'consumer'};
                   4793:             }
                   4794:         }
                   4795:     }
                   4796:     my $output = '<input type="hidden" name="set_'.$thiskey.'" /><table><tr>';
                   4797:     foreach my $item ('listing','scope','urls') {
                   4798:         $output .= '<th>'.$titles{$item}.'</th>';
                   4799:     }
                   4800:     $output .= '</tr><tr>';
                   4801:     foreach my $item (@components) {
                   4802:         $output .= '<td>';
                   4803:         if ($item eq 'urls') {
                   4804:             my $selected = $values{$item};
                   4805:             foreach my $option (@{$options{$item}}) {
                   4806:                 if ($option eq 'lti') {
                   4807:                     next unless (keys(%posslti));
                   4808:                 }
                   4809:                 my $checked;
                   4810:                 if ($selected =~ /^\Q$option\E/) {
                   4811:                     $checked = ' checked="checked"';
                   4812:                 }
                   4813:                 my $onclick;
                   4814:                 unless ($readonly) {
                   4815:                     my $esc_key = &js_escape($thiskey);
                   4816:                     $onclick = ' onclick="toggleDeepLink(this.form,'."'$item','$esc_key'".');"';
                   4817:                 }
                   4818:                 $output .= '<span class="LC_nobreak"><label>'.
                   4819:                            '<input type="radio" name="deeplink_'.$item.'_'.$thiskey.'" value="'.$option.'"'.$onclick.$disabled.$checked.' />'."\n".
                   4820:                            $optiontext{$option}.'</label>';
                   4821:                 if ($option eq 'key') {
                   4822:                     my $visibility="hidden";
                   4823:                     my $currkey;
                   4824:                     if ($checked) {
                   4825:                         $visibility = "text";
                   4826:                         $currkey = (split(/\:/,$values{$item}))[1];
                   4827:                     }
                   4828:                     $output .= '&nbsp;'.
                   4829:                         '<input type="'.$visibility.'" name="deeplink_'.$option.'_'.$thiskey.'" id="deeplink_'.$option.'_'.$item.'_'.$thiskey.'" value="'.$currkey.'" size="6"'.$disabled.' />';
                   4830:                 } elsif ($option eq 'lti') {
                   4831:                     my $display="none";
                   4832:                     my ($currlti,$blankcheck);
                   4833:                     if ($checked) {
                   4834:                         $display = 'inline-block';
                   4835:                         $currlti = (split(/\:/,$values{$item}))[1];
                   4836:                     } else {
                   4837:                         $blankcheck = ' selected="selected"';
                   4838:                     }
                   4839:                     $output .= '<div id="deeplinkdiv_'.$option.'_'.$item.'_'.$thiskey.'"'.
                   4840:                                ' style="display: '.$display.'">&nbsp;<select name="'.
                   4841:                                'deeplink_'.$option.'_'.$thiskey.'"'.$disabled.'>'.
                   4842:                                '<option value=""'.$blankcheck.'>'.&mt('Select Provider').'</option>'."\n";
                   4843:                     foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   4844:                         my $selected;
                   4845:                         if ($lti == $currlti) {
                   4846:                             $selected = ' selected="selected"';
                   4847:                         }
                   4848:                         $output .= '<option value="'.$lti.'"'.$selected.'>'.$posslti{$lti}.'</option>';
                   4849:                     }
                   4850:                     $output .= '</select></div>';
                   4851:                 }
                   4852:                 $output .= '</span> ';
                   4853:             }
                   4854:         } else {
                   4855:             my $selected = $values{$item};
                   4856:             my $defsel;
                   4857:             if ($selected eq '') {
                   4858:                 $defsel = ' selected="selected"';
                   4859:             }
                   4860:             $output .= '<select name="deeplink_'.$item.'_'.$thiskey.'"'.$disabled.'>'."\n".
                   4861:                        '<option value=""'.$defsel.'>'.&mt('Please select').'</option>'."\n";
                   4862:             foreach my $option (@{$options{$item}}) {
                   4863:                 $output .= '<option value="'.$option.'"';
                   4864:                 if ($option eq $selected) {
                   4865:                     $output .= ' selected="selected"';
                   4866:                 }
                   4867:                 $output .= '>'.$optiontext{$option}.'</option>';
                   4868:             }
                   4869:             $output .= '</select>';
                   4870:         }
                   4871:         $output .= '</td>';
                   4872:     }
                   4873:     $output .= '</tr></table>'."\n";
                   4874:     return $output;
                   4875: }
                   4876: 
1.560     damieng  4877: 
                   4878: { # block using some constants related to parameter types (overview mode)
                   4879: 
1.446     bisitz   4880: my %strings =
1.383     albertel 4881:     (
                   4882:      'string_yesno'
                   4883:              => [[ 'yes', 'Yes' ],
1.560     damieng  4884:                  [ 'no', 'No' ]],
1.383     albertel 4885:      'string_problemstatus'
                   4886:              => [[ 'yes', 'Yes' ],
1.473     amueller 4887:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4888:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4889:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4890:      'string_questiontype'
                   4891:              => [[ 'problem', 'Standard Problem'],
                   4892:                  [ 'survey', 'Survey'],
                   4893:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4894:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4895:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4896:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4897:                  [ 'practice', 'Practice'],
                   4898:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4899:      'string_lenient'
                   4900:              => [['yes', 'Yes' ],
                   4901:                  [ 'no', 'No' ],
1.549     raeburn  4902:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4903:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4904:      'string_discussvote'
                   4905:              => [['yes','Yes'],
                   4906:                  ['notended','Yes, unless discussion ended'],
                   4907:                  ['no','No']],
1.549     raeburn  4908:      'string_ip'
                   4909:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
1.587     raeburn  4910:                  ['_denyfrom_','Hostname(s) or IP(s) from which access is disallowed']], 
                   4911:      'string_deeplink'
1.588     raeburn  4912:              => [['on','Set choices for link protection, resource listing, and access scope']],
1.587     raeburn  4913:     );
                   4914:    
1.383     albertel 4915: 
1.549     raeburn  4916: my %stringmatches = (
                   4917:          'string_lenient'
                   4918:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4919:          'string_ip'
                   4920:               => [['_allowfrom_','[^\!]+'],
                   4921:                   ['_denyfrom_','\!']],
1.588     raeburn  4922:          'string_deeplink'
                   4923:               => [['on','^(full|absent|grades|details|datestatus)\,(res|map|rec)\,(any|only|key\:\w+|lti\:\d+)$']],
1.549     raeburn  4924:     );
                   4925: 
                   4926: my %stringtypes = (
                   4927:                     type         => 'string_questiontype',
                   4928:                     lenient      => 'string_lenient',
                   4929:                     retrypartial => 'string_yesno',
                   4930:                     discussvote  => 'string_discussvote',
                   4931:                     examcode     => 'string_examcode',
                   4932:                     acc          => 'string_ip',
1.587     raeburn  4933:                     deeplink     => 'string_deeplink',
1.549     raeburn  4934:                   );
                   4935: 
1.563     damieng  4936: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4937: # Used by courseprefs.
                   4938: #
                   4939: # @param {string} $string_type - a parameter type for strings
                   4940: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4941: sub standard_string_options {
                   4942:     my ($string_type) = @_;
                   4943:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4944:         return $strings{$string_type};
                   4945:     }
                   4946:     return;
                   4947: }
1.383     albertel 4948: 
1.563     damieng  4949: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4950: #
                   4951: # @param {string} $string_type - a parameter type for strings
                   4952: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4953: sub standard_string_matches {
                   4954:     my ($string_type) = @_;
                   4955:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4956:         return $stringmatches{$string_type};
                   4957:     }
                   4958:     return;
                   4959: }
                   4960: 
1.563     damieng  4961: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4962: #
                   4963: # @param {string} $name - parameter name
                   4964: # @returns {string}
1.549     raeburn  4965: sub get_stringtype {
                   4966:     my ($name) = @_;
                   4967:     if (exists($stringtypes{$name})) {
                   4968:         return $stringtypes{$name};
                   4969:     }
                   4970:     return;
                   4971: }
                   4972: 
1.563     damieng  4973: # Returns HTML to edit a string parameter.
                   4974: #
                   4975: # @param {string} $thistype - parameter type
                   4976: # @param {string} $thiskey - parameter key
                   4977: # @param {string} $showval - parameter current value
                   4978: # @param {string} $name - parameter name
                   4979: # @param {boolean} $readonly - true if the values should not be made editable
                   4980: # @returns {string}
1.383     albertel 4981: sub string_selector {
1.552     raeburn  4982:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4983: 
1.383     albertel 4984:     if (!exists($strings{$thistype})) {
1.552     raeburn  4985:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4986:     }
                   4987: 
1.504     raeburn  4988:     my %skiptype;
1.514     raeburn  4989:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4990:             ($thistype eq 'string_lenient') ||
                   4991:             ($thistype eq 'string_discussvote') ||
                   4992:             ($thistype eq 'string_ip') ||
1.588     raeburn  4993:             ($thistype eq 'string_deeplink') ||
1.560     damieng  4994:             ($name eq 'retrypartial')) {
1.504     raeburn  4995:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4996:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4997:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4998:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4999:             my $parmmatch;
                   5000:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   5001:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   5002:                     if (ref($item) eq 'ARRAY') {
                   5003:                         if ($parmval eq $item->[0]) {
                   5004:                             $parmmatch = $parmval;
                   5005:                             $parmval = '';
                   5006:                             last;
                   5007:                         }
                   5008:                     }
                   5009:                 }
                   5010:             }
                   5011:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  5012:             if ($needsrelease) {
                   5013:                 unless ($got_chostname) {
1.514     raeburn  5014:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  5015:                     $got_chostname = 1;
                   5016:                 }
1.557     raeburn  5017:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  5018:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  5019:                 if ($needsnewer) {
1.549     raeburn  5020:                     if ($parmmatch ne '') {
                   5021:                         $skiptype{$parmmatch} = 1;
                   5022:                     } elsif ($parmval ne '') {
                   5023:                         $skiptype{$parmval} = 1;
                   5024:                     }
1.504     raeburn  5025:                 }
                   5026:             }
                   5027:         }
                   5028:     }
1.549     raeburn  5029: 
                   5030:     if ($thistype eq 'string_ip') {
1.552     raeburn  5031:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.588     raeburn  5032:     } elsif ($thistype eq 'string_deeplink') {
                   5033:         return &string_deeplink_selector($thiskey,$showval,$readonly);
1.549     raeburn  5034:     }
1.504     raeburn  5035: 
1.552     raeburn  5036:     my ($result,$disabled);
                   5037: 
                   5038:     if ($readonly) {
                   5039:         $disabled = ' disabled="disabled"';
                   5040:     }
1.504     raeburn  5041:     my $numinrow = 3;
                   5042:     if ($thistype eq 'string_problemstatus') {
                   5043:         $numinrow = 2;
                   5044:     } elsif ($thistype eq 'string_questiontype') {
                   5045:         if (keys(%skiptype) > 0) {
                   5046:              $numinrow = 4;
                   5047:         }
                   5048:     }
                   5049:     my $rem;
                   5050:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   5051:         my $i=0;
                   5052:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   5053:             next unless (ref($possibilities) eq 'ARRAY');
                   5054:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  5055:             next if ($skiptype{$name});
1.504     raeburn  5056:             $rem = $i%($numinrow);
                   5057:             if ($rem == 0) {
                   5058:                 if ($i > 0) {
                   5059:                     $result .= '</tr>';
                   5060:                 }
                   5061:                 $result .= '<tr>';
                   5062:             }
1.549     raeburn  5063:             my $colspan;
                   5064:             if ($i == @{ $strings{$thistype} }-1) {
                   5065:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   5066:                 if ($rem) {
                   5067:                     my $colsleft = $numinrow - $rem;
                   5068:                     if ($colsleft) {
                   5069:                         $colspan = $colsleft+1;
                   5070:                         $colspan = ' colspan="'.$colspan.'"';
                   5071:                     }
                   5072:                 }
                   5073:             }
                   5074:             my ($add,$onchange,$css_class);
                   5075:             if ($thistype eq 'string_lenient') {
                   5076:                 if ($name eq 'weighted') {
                   5077:                     my $display;
                   5078:                     my %relatives = &Apache::lonlocal::texthash(
                   5079:                                         corrchkd     => 'Correct (checked)',
                   5080:                                         corrunchkd   => 'Correct (unchecked)',
                   5081:                                         incorrchkd   => 'Incorrect (checked)',
                   5082:                                         incorrunchkd => 'Incorrect (unchecked)',
                   5083:                     );
                   5084:                     my %textval = (
                   5085:                                     corrchkd     => '1.0',
                   5086:                                     corrunchkd   => '1.0',
                   5087:                                     incorrchkd   => '0.0',
                   5088:                                     incorrunchkd => '0.0',
                   5089:                     );
                   5090:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   5091:                         $textval{'corrchkd'} = $1;
                   5092:                         $textval{'corrunchkd'} = $2;
                   5093:                         $textval{'incorrchkd'} = $3;
                   5094:                         $textval{'incorrunchkd'} = $4;
                   5095:                         $display = 'inline';
                   5096:                         $showval = $name;
                   5097:                     } else {
                   5098:                         $display = 'none';
                   5099:                     }
                   5100:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   5101:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   5102:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   5103:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   5104:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  5105:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  5106:                                 '</td></tr>';
                   5107:                     }
                   5108:                     $add .= '</table></div>'."\n";
                   5109:                 }
                   5110:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   5111:                 $css_class = ' class="LC_lenient_radio"';
                   5112:             }
                   5113:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  5114:                        '<span class="LC_nobreak"><label>'.
                   5115:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  5116:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  5117:             if ($showval eq $name) {
                   5118:                 $result .= ' checked="checked"';
                   5119:             }
1.549     raeburn  5120:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  5121:             $i++;
                   5122:         }
                   5123:         $result .= '</tr>';
1.473     amueller 5124:     }
1.504     raeburn  5125:     if ($result) {
                   5126:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 5127:     }
                   5128:     return $result;
                   5129: }
                   5130: 
1.554     raeburn  5131: my %intervals =
                   5132:     (
                   5133:      'date_interval'
                   5134:              => [[ 'done', 'Yes' ],
1.558     raeburn  5135:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  5136:                  [ '', 'No' ]],
                   5137:     );
                   5138: 
                   5139: my %intervalmatches = (
                   5140:          'date_interval'
1.559     raeburn  5141:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   5142:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  5143:     );
                   5144: 
                   5145: my %intervaltypes = (
                   5146:                       interval => 'date_interval',
                   5147:     );
                   5148: 
1.563     damieng  5149: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   5150: #
                   5151: # @param {string} $interval_type - a parameter type for intervals
                   5152: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  5153: sub standard_interval_matches {
                   5154:     my ($interval_type) = @_;
                   5155:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   5156:         return $intervalmatches{$interval_type};
                   5157:     }
                   5158:     return;
                   5159: }
                   5160: 
1.563     damieng  5161: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   5162: #
                   5163: # @param {string} $name - parameter name
                   5164: # @returns {string}
1.554     raeburn  5165: sub get_intervaltype {
                   5166:     my ($name) = @_;
                   5167:     if (exists($intervaltypes{$name})) {
                   5168:         return $intervaltypes{$name};
                   5169:     }
                   5170:     return;
                   5171: }
                   5172: 
1.563     damieng  5173: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   5174: # Used by courseprefs.
                   5175: #
                   5176: # @param {string} $interval_type - a parameter type for intervals
                   5177: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  5178: sub standard_interval_options {
                   5179:     my ($interval_type) = @_;
                   5180:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   5181:         return $intervals{$interval_type};
                   5182:     }
                   5183:     return;
                   5184: }
                   5185: 
1.563     damieng  5186: # Returns HTML to edit a date interval parameter.
                   5187: #
                   5188: # @param {string} $thiskey - parameter key
                   5189: # @param {string} $name - parameter name
                   5190: # @param {string} $showval - parameter current value
                   5191: # @param {boolean} $readonly - true if the values should not be made editable
                   5192: # @returns {string}
1.554     raeburn  5193: sub date_interval_selector {
                   5194:     my ($thiskey, $name, $showval, $readonly) = @_;
                   5195:     my ($result,%skipval);
                   5196:     if ($name eq 'interval') {
                   5197:         my $intervaltype = &get_intervaltype($name);
                   5198:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   5199:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   5200:             next unless (ref($possibilities) eq 'ARRAY');
                   5201:             my ($parmval, $description) = @{ $possibilities };
                   5202:             my $parmmatch;
                   5203:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   5204:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   5205:                     if (ref($item) eq 'ARRAY') {
                   5206:                         if ($parmval eq $item->[0]) {
                   5207:                             $parmmatch = $parmval;
                   5208:                             $parmval = '';
                   5209:                             last;
                   5210:                         }
                   5211:                     }
                   5212:                 }
                   5213:             }
                   5214:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   5215:             if ($needsrelease) {
                   5216:                 unless ($got_chostname) {
                   5217:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   5218:                     $got_chostname = 1;
                   5219:                 }
1.557     raeburn  5220:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  5221:                                                        $needsrelease,$cmajor,$cminor);
                   5222:                 if ($needsnewer) {
                   5223:                     if ($parmmatch ne '') {
                   5224:                         $skipval{$parmmatch} = 1;
                   5225:                     } elsif ($parmval ne '') {
                   5226:                         $skipval{$parmval} = 1;
                   5227:                     }
                   5228:                 }
                   5229:             }
                   5230:         }
                   5231:     }
                   5232: 
                   5233:     my $currval = $showval;
                   5234:     foreach my $which (['days', 86400, 31],
                   5235:                ['hours', 3600, 23],
                   5236:                ['minutes', 60, 59],
                   5237:                ['seconds',  1, 59]) {
1.560     damieng  5238:         my ($name, $factor, $max) = @{ $which };
                   5239:         my $amount = int($showval/$factor);
                   5240:         $showval  %= $factor;
                   5241:         my %select = ((map {$_ => $_} (0..$max)),
                   5242:                 'select_form_order' => [0..$max]);
                   5243:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   5244:                             \%select,'',$readonly);
                   5245:         $result .= ' '.&mt($name);
1.554     raeburn  5246:     }
                   5247:     if ($name eq 'interval') {
                   5248:         unless ($skipval{'done'}) {
                   5249:             my $checkedon = '';
1.558     raeburn  5250:             my $checkedproc = '';
                   5251:             my $currproctorkey = '';
                   5252:             my $currprocdisplay = 'hidden';
1.559     raeburn  5253:             my $currdonetext = &mt('Done');
1.554     raeburn  5254:             my $checkedoff = ' checked="checked"';
1.559     raeburn  5255:             if ($currval =~ /^(?:\d+)_done$/) {
                   5256:                 $checkedon = ' checked="checked"';
                   5257:                 $checkedoff = '';
                   5258:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   5259:                 $currdonetext = $1;
1.554     raeburn  5260:                 $checkedon = ' checked="checked"';
                   5261:                 $checkedoff = '';
1.558     raeburn  5262:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   5263:                 $currproctorkey = $1;
                   5264:                 $checkedproc = ' checked="checked"';
                   5265:                 $checkedoff = '';
                   5266:                 $currprocdisplay = 'text';
1.559     raeburn  5267:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   5268:                 $currdonetext = $1;
                   5269:                 $currproctorkey = $2;
                   5270:                 $checkedproc = ' checked="checked"';
                   5271:                 $checkedoff = '';
                   5272:                 $currprocdisplay = 'text';
1.554     raeburn  5273:             }
1.558     raeburn  5274:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  5275:             my $disabled;
                   5276:             if ($readonly) {
                   5277:                 $disabled = ' disabled="disabled"';
                   5278:             }
1.558     raeburn  5279:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  5280:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  5281:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  5282:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  5283:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  5284:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  5285:                        &mt('Yes, with proctor key').'</label>'.
                   5286:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  5287:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  5288:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  5289:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  5290:         }
                   5291:     }
                   5292:     unless ($readonly) {
                   5293:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   5294:     }
                   5295:     return $result;
                   5296: }
                   5297: 
1.563     damieng  5298: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   5299: #
                   5300: # @param {string} $name - parameter name
                   5301: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5302: # @param {string} $value - parameter value
                   5303: # @param {string} $chostname - course server name
                   5304: # @param {integer} $cmajor - major version number
                   5305: # @param {integer} $cminor - minor version number
                   5306: # @param {string} $needsrelease - release version needed (major.minor)
                   5307: # @returns {string}
1.549     raeburn  5308: sub oldversion_warning {
1.557     raeburn  5309:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   5310:     my $standard_name = &standard_parameter_names($name);
                   5311:     if ($namematch) {
                   5312:         my $level = &standard_parameter_levels($namematch);
                   5313:         my $msg = '';
                   5314:         if ($level) {
                   5315:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   5316:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   5317:         } else {
                   5318:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   5319:                       $standard_name,'<b>','</b>');
                   5320:         }
                   5321:         return '<p class="LC_warning">'.$msg.'<br />'.
                   5322:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5323:                    $cmajor.'.'.$cminor,$chostname,
                   5324:                    $needsrelease).
                   5325:                    '</p>';
                   5326:     }
1.549     raeburn  5327:     my $desc;
                   5328:     my $stringtype = &get_stringtype($name);
                   5329:     if ($stringtype ne '') {
                   5330:         if ($name eq 'examcode') {
                   5331:             $desc = $value;
                   5332:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   5333:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   5334:                 next unless (ref($possibilities) eq 'ARRAY');
                   5335:                 my ($parmval, $description) = @{ $possibilities };
                   5336:                 my $parmmatch;
                   5337:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   5338:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   5339:                         if (ref($item) eq 'ARRAY') {
                   5340:                             my ($regexpname,$pattern) = @{$item};
                   5341:                             if ($parmval eq $regexpname) {
                   5342:                                 if ($value =~ /$pattern/) {
                   5343:                                     $desc = $description; 
                   5344:                                     $parmmatch = 1;
                   5345:                                     last;
                   5346:                                 }
                   5347:                             }
                   5348:                         }
                   5349:                     }
                   5350:                     last if ($parmmatch);
                   5351:                 } elsif ($parmval eq $value) {
                   5352:                     $desc = $description;
                   5353:                     last;
                   5354:                 }
                   5355:             }
                   5356:         }
                   5357:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   5358:         my $now = time;
                   5359:         if ($value =~ /^\d+$/) {
                   5360:             if ($name eq 'printstartdate') {
                   5361:                 if ($value > $now) {
                   5362:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5363:                 }
                   5364:             } elsif ($name eq 'printenddate') {
                   5365:                 if ($value < $now) {
                   5366:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5367:                 }
                   5368:             }
                   5369:         }
                   5370:     }
                   5371:     return '<p class="LC_warning">'.
1.557     raeburn  5372:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   5373:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   5374:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5375:        $cmajor.'.'.$cminor,$chostname,
                   5376:        $needsrelease).
                   5377:        '</p>';
1.549     raeburn  5378: }
                   5379: 
1.560     damieng  5380: } # end of block using some constants related to parameter types
                   5381: 
1.549     raeburn  5382: 
1.563     damieng  5383: 
                   5384: # Shifts all start and end dates in the current course by $shift.
1.389     www      5385: #
1.563     damieng  5386: # @param {integer} $shift - time to shift, in seconds
                   5387: # @returns {string} - error name or 'ok'
1.389     www      5388: sub dateshift {
                   5389:     my ($shift)=@_;
                   5390:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5391:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5392:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   5393: # ugly retro fix for broken version of types
1.548     raeburn  5394:     foreach my $key (keys(%data)) {
1.389     www      5395:         if ($key=~/\wtype$/) {
                   5396:             my $newkey=$key;
                   5397:             $newkey=~s/type$/\.type/;
                   5398:             $data{$newkey}=$data{$key};
                   5399:             delete $data{$key};
                   5400:         }
                   5401:     }
1.391     www      5402:     my %storecontent=();
1.389     www      5403: # go through all parameters and look for dates
1.548     raeburn  5404:     foreach my $key (keys(%data)) {
1.389     www      5405:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   5406:           my $newdate=$data{$key}+$shift;
1.391     www      5407:           $storecontent{$key}=$newdate;
1.389     www      5408:        }
                   5409:     }
1.391     www      5410:     my $reply=&Apache::lonnet::cput
                   5411:                 ('resourcedata',\%storecontent,$dom,$crs);
                   5412:     if ($reply eq 'ok') {
                   5413:        &log_parmset(\%storecontent);
                   5414:     }
                   5415:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   5416:     return $reply;
1.389     www      5417: }
                   5418: 
1.563     damieng  5419: # Overview mode UI to edit course parameters.
                   5420: #
                   5421: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5422: sub newoverview {
1.568     raeburn  5423:     my ($r,$parm_permission) = @_;
1.280     albertel 5424: 
1.208     www      5425:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5426:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5427:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5428:     my $readonly = 1;
                   5429:     if ($parm_permission->{'edit'}) {
                   5430:         undef($readonly);
                   5431:     }
1.414     droeschl 5432:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5433:         text=>"Overview Mode"});
1.523     raeburn  5434: 
                   5435:     my %loaditems = (
1.549     raeburn  5436:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5437:                     );
                   5438:     my $js = '
                   5439: <script type="text/javascript">
                   5440: // <![CDATA[
                   5441: '.
                   5442:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5443:             &showhide_js()."\n".
1.549     raeburn  5444:             &toggleparmtextbox_js()."\n".
                   5445:             &validateparms_js()."\n".
                   5446:             &ipacc_boxes_js()."\n".
1.558     raeburn  5447:             &done_proctor_js()."\n".
1.588     raeburn  5448:             &deeplink_js()."\n".
1.523     raeburn  5449: '// ]]>
                   5450: </script>
                   5451: ';
1.549     raeburn  5452: 
1.523     raeburn  5453:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5454:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5455:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5456:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5457:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5458:     $r->print(<<ENDOVER);
1.549     raeburn  5459: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5460: ENDOVER
1.211     www      5461:     my @ids=();
                   5462:     my %typep=();
                   5463:     my %keyp=();
                   5464:     my %allparms=();
                   5465:     my %allparts=();
                   5466:     my %allmaps=();
                   5467:     my %mapp=();
                   5468:     my %symbp=();
                   5469:     my %maptitles=();
                   5470:     my %uris=();
                   5471:     my %keyorder=&standardkeyorder();
                   5472:     my %defkeytype=();
                   5473: 
                   5474:     my %alllevs=();
                   5475:     $alllevs{'Resource Level'}='full';
1.215     www      5476:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5477:     $alllevs{'Course Level'}='general';
                   5478: 
                   5479:     my $csec=$env{'form.csec'};
1.269     raeburn  5480:     my $cgroup=$env{'form.cgroup'};
1.211     www      5481: 
                   5482:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5483:     my $pschp=$env{'form.pschp'};
1.506     www      5484: 
1.211     www      5485:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5486:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5487: 
1.446     bisitz   5488:     my @selected_sections =
1.473     amueller 5489:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5490:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5491:     foreach my $sec (@selected_sections) {
                   5492:         if ($sec eq 'all') {
1.211     www      5493:             @selected_sections = ('all');
                   5494:         }
                   5495:     }
1.552     raeburn  5496:     if ($env{'request.course.sec'} ne '') {
                   5497:         @selected_sections = ($env{'request.course.sec'});
                   5498:     }
1.269     raeburn  5499:     my @selected_groups =
                   5500:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5501: 
                   5502:     my $pssymb='';
                   5503:     my $parmlev='';
1.446     bisitz   5504: 
1.211     www      5505:     unless ($env{'form.parmlev'}) {
                   5506:         $parmlev = 'map';
                   5507:     } else {
                   5508:         $parmlev = $env{'form.parmlev'};
                   5509:     }
                   5510: 
1.446     bisitz   5511:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5512:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5513:                 \%keyorder,\%defkeytype);
1.211     www      5514: 
1.374     albertel 5515:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5516:         @psprt = keys(%allparts);
1.374     albertel 5517:     }
1.211     www      5518: # Menu to select levels, etc
                   5519: 
1.456     bisitz   5520:     $r->print('<div class="LC_Box">');
1.445     neumanie 5521:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5522:     $r->print('<div>');
1.523     raeburn  5523:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5524:     &levelmenu($r,\%alllevs,$parmlev);
                   5525:     if ($parmlev ne 'general') {
1.447     bisitz   5526:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5527:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5528:     }
1.447     bisitz   5529:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5530:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5531:     $r->print('</div></div>');
1.446     bisitz   5532: 
1.456     bisitz   5533:     $r->print('<div class="LC_Box">');
1.452     bisitz   5534:     $r->print('<div>');
1.581     raeburn  5535:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5536:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5537:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5538:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5539:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5540:     $r->print('<table>'.
1.553     raeburn  5541:               '<tr><th>'.&mt('Parts').'</th>');
                   5542:     if ($sectionselector) {
                   5543:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5544:     }
                   5545:     if ($groupselector) {
                   5546:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5547:     }
                   5548:     $r->print('</tr><tr><td>');
1.211     www      5549:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5550:     $r->print('</td>');
                   5551:     if ($sectionselector) { 
                   5552:         $r->print('<td>'.$sectionselector.'</td>');
                   5553:     }
                   5554:     if ($groupselector) {
                   5555:         $r->print('<td>'.$groupselector.'</td>');
                   5556:     }
                   5557:     $r->print('</tr></table>');
1.447     bisitz   5558:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5559:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5560:     $r->print('</div></div>');
                   5561: 
1.456     bisitz   5562:     $r->print('<div class="LC_Box">');
1.452     bisitz   5563:     $r->print('<div>');
1.214     www      5564:     my $sortorder=$env{'form.sortorder'};
                   5565:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5566:     &sortmenu($r,$sortorder);
1.445     neumanie 5567:     $r->print('</div></div>');
1.446     bisitz   5568: 
1.214     www      5569:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5570: 
1.211     www      5571: # Build the list data hash from the specified parms
                   5572: 
                   5573:     my $listdata;
                   5574:     %{$listdata}=();
                   5575: 
                   5576:     foreach my $cat (@pscat) {
1.269     raeburn  5577:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5578:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5579:     }
                   5580: 
1.212     www      5581:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5582: 
1.481     amueller 5583:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5584: 
                   5585: # Read modified data
                   5586: 
1.481     amueller 5587:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5588: 
                   5589: # List data
                   5590: 
1.568     raeburn  5591:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5592:     }
                   5593:     $r->print(&tableend());
                   5594:     unless ($readonly) {
                   5595:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5596:     }
1.568     raeburn  5597:     $r->print('</form>');
1.507     www      5598:     &endSettingsScreen($r);
                   5599:     $r->print(&Apache::loncommon::end_page());
1.208     www      5600: }
                   5601: 
1.563     damieng  5602: # Fills $listdata with parameter information.
                   5603: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5604: # The non-type value is always 1.
                   5605: #
                   5606: # @param {string} $cat - parameter name
1.566     damieng  5607: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5608: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5609: # @param {hash reference} $listdata - the parameter data that will be modified
                   5610: # @param {array reference} $psprt - selected parts
                   5611: # @param {array reference} $selections - selected sections
                   5612: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5613: # @param {hash reference} $allmaps - hash map pc -> map src
                   5614: # @param {array reference} $ids - resource and map ids
                   5615: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5616: sub secgroup_lister {
                   5617:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5618:     foreach my $item (@{$selections}) {
                   5619:         foreach my $part (@{$psprt}) {
                   5620:             my $rootparmkey=$env{'request.course.id'};
                   5621:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5622:                 $rootparmkey.='.['.$item.']';
                   5623:             }
                   5624:             if ($parmlev eq 'general') {
                   5625: # course-level parameter
                   5626:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5627:                 $$listdata{$newparmkey}=1;
                   5628:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5629:             } elsif ($parmlev eq 'map') {
                   5630: # map-level parameter
1.548     raeburn  5631:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5632:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5633:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5634:                     $$listdata{$newparmkey}=1;
                   5635:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5636:                 }
                   5637:             } else {
                   5638: # resource-level parameter
                   5639:                 foreach my $rid (@{$ids}) {
                   5640:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5641:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5642:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5643:                     $$listdata{$newparmkey}=1;
                   5644:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5645:                 }
                   5646:             }
                   5647:         }
                   5648:     }
                   5649: }
                   5650: 
1.563     damieng  5651: # UI to edit parameter settings starting with a list of all existing parameters.
                   5652: # (called by setoverview action)
                   5653: #
                   5654: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5655: sub overview {
1.568     raeburn  5656:     my ($r,$parm_permission) = @_;
1.208     www      5657:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5658:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5659:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5660:     my $readonly = 1;
                   5661:     if ($parm_permission->{'edit'}) {
                   5662:         undef($readonly);
                   5663:     }
1.549     raeburn  5664:     my $js = '<script type="text/javascript">'."\n".
                   5665:              '// <![CDATA['."\n".
                   5666:              &toggleparmtextbox_js()."\n".
                   5667:              &validateparms_js()."\n".
                   5668:              &ipacc_boxes_js()."\n".
1.558     raeburn  5669:              &done_proctor_js()."\n".
1.588     raeburn  5670:              &deeplink_js()."\n".
1.549     raeburn  5671:              '// ]]>'."\n".
                   5672:              '</script>'."\n";
1.414     droeschl 5673:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5674:     text=>"Overview Mode"});
1.549     raeburn  5675:     my %loaditems = (
                   5676:                       'onload'   => "showHideLenient();",
                   5677:                     );
                   5678: 
                   5679:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5680:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5681:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5682:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5683:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5684: 
1.208     www      5685: # Store modified
                   5686: 
1.568     raeburn  5687:     unless ($readonly) {
                   5688:         &storedata($r,$crs,$dom);
                   5689:     }
1.208     www      5690: 
                   5691: # Read modified data
                   5692: 
1.552     raeburn  5693:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5694: 
1.214     www      5695: 
                   5696:     my $sortorder=$env{'form.sortorder'};
                   5697:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5698:     &sortmenu($r,$sortorder);
                   5699: 
1.568     raeburn  5700:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5701: 
                   5702:     if ($readonly) {
                   5703:         $r->print('<p>'.$submitbutton.'</p>');
                   5704:     }
                   5705: 
1.208     www      5706: # List data
                   5707: 
1.568     raeburn  5708:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5709:     $r->print(&tableend().'<p>');
                   5710:     if ($foundkeys) {
                   5711:         unless ($readonly) {
                   5712:             $r->print('<p>'.$submitbutton.'</p>');
                   5713:         }
                   5714:     } else {
                   5715:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5716:     }
                   5717:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5718: }
1.121     www      5719: 
1.560     damieng  5720: # Unused sub.
1.563     damieng  5721: #
                   5722: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5723: sub clean_parameters {
                   5724:     my ($r) = @_;
                   5725:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5726:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5727: 
1.414     droeschl 5728:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5729:         text=>"Clean Parameters"});
1.333     albertel 5730:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5731:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5732:     $r->print(<<ENDOVER);
                   5733: $start_page
                   5734: $breadcrumbs
                   5735: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5736: ENDOVER
                   5737: # Store modified
                   5738: 
                   5739:     &storedata($r,$crs,$dom);
                   5740: 
                   5741: # Read modified data
                   5742: 
                   5743:     my $resourcedata=&readdata($crs,$dom);
                   5744: 
                   5745: # List data
                   5746: 
                   5747:     $r->print('<h3>'.
1.473     amueller 5748:           &mt('These parameters refer to resources that do not exist.').
                   5749:           '</h3>'.
                   5750:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5751:           '<br />');
1.333     albertel 5752:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5753:           '<tr>'.
                   5754:           '<th>'.&mt('Delete').'</th>'.
                   5755:           '<th>'.&mt('Parameter').'</th>'.
                   5756:           '</tr>');
1.333     albertel 5757:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5758:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5759:             && $thiskey=~/\.type$/);
                   5760:         my %data = &parse_key($thiskey);
                   5761:         if (1) { #exists($data{'realm_exists'})
                   5762:             #&& !$data{'realm_exists'}) {
                   5763:             $r->print(&Apache::loncommon::start_data_table_row().
                   5764:                 '<tr>'.
                   5765:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5766: 
                   5767:             $r->print('<td>');
                   5768:             my $display_value = $resourcedata->{$thiskey};
                   5769:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5770:             $display_value =
                   5771:                 &Apache::lonlocal::locallocaltime($display_value);
                   5772:             }
1.470     raeburn  5773:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5774:             $parmitem = &mt($parmitem);
1.560     damieng  5775:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5776:                 $parmitem,$resourcedata->{$thiskey}));
                   5777:             $r->print('<br />');
                   5778:             if ($data{'scope_type'} eq 'all') {
                   5779:                 $r->print(&mt('All users'));
                   5780:             } elsif ($data{'scope_type'} eq 'user') {
                   5781:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581     raeburn  5782:             } elsif ($data{'scope_type'} eq 'secgroup') {
                   5783:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5784:             }
                   5785:             $r->print('<br />');
                   5786:             if ($data{'realm_type'} eq 'all') {
                   5787:                 $r->print(&mt('All Resources'));
                   5788:             } elsif ($data{'realm_type'} eq 'folder') {
                   5789:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5790:             } elsif ($data{'realm_type'} eq 'symb') {
                   5791:             my ($map,$resid,$url) =
                   5792:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5793:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5794:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5795:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5796:             }
                   5797:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5798:             $r->print('</td></tr>');
                   5799: 
1.473     amueller 5800:         }
1.333     albertel 5801:     }
                   5802:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5803:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5804:           '</p></form>');
                   5805:     &endSettingsScreen($r);
                   5806:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5807: }
                   5808: 
1.563     damieng  5809: # UI to shift all dates (called by dateshift1 action).
                   5810: # Used by overview mode.
                   5811: #
                   5812: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5813: sub date_shift_one {
                   5814:     my ($r) = @_;
                   5815:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5816:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5817:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5818: 
1.414     droeschl 5819:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5820:         text=>"Shifting Dates"});
1.390     www      5821:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5822:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5823:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5824:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5825:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5826:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5827:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5828:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5829:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5830:                                                         'timeshifted',
                   5831:                                                         $env{'form.timebase'},,
                   5832:                                                         '').
                   5833:               '</td></tr></table>'.
                   5834:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5835:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5836:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5837:     &endSettingsScreen($r);
1.390     www      5838:     $r->print(&Apache::loncommon::end_page());
                   5839: }
                   5840: 
1.563     damieng  5841: # UI to shift all dates (second form).
                   5842: #
                   5843: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5844: sub date_shift_two {
                   5845:     my ($r) = @_;
                   5846:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5847:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5848:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5849:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5850:         text=>"Shifting Dates"});
1.390     www      5851:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5852:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5853:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5854:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5855:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5856:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5857:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5858:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5859:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5860:     my $delta=$timeshifted-$env{'form.timebase'};
                   5861:     &dateshift($delta);
1.543     bisitz   5862:     $r->print(
                   5863:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5864:         '<br /><br />'.
                   5865:         &Apache::lonhtmlcommon::actionbox(
                   5866:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5867:     &endSettingsScreen($r);
1.390     www      5868:     $r->print(&Apache::loncommon::end_page());
                   5869: }
                   5870: 
1.563     damieng  5871: # Returns the different components of a resourcedata key.
                   5872: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5873: #       realm_exists, parameter_part, parameter_name.
                   5874: # Was used by clean_parameters (which is unused).
                   5875: #
                   5876: # @param {string} $key - the parameter key
                   5877: # @returns {hash}
1.333     albertel 5878: sub parse_key {
                   5879:     my ($key) = @_;
                   5880:     my %data;
                   5881:     my ($middle,$part,$name)=
1.572     damieng  5882:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5883:     $data{'scope_type'} = 'all';
                   5884:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5885:         $data{'scope'} = $1;
                   5886:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5887:             $data{'scope_type'} = 'user';
                   5888:             $data{'scope'} = [$1,$2];
                   5889:         } else {
1.581     raeburn  5890:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5891:         }
                   5892:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5893:     }
                   5894:     $middle=~s/\.+$//;
                   5895:     $middle=~s/^\.+//;
                   5896:     $data{'realm_type'}='all';
                   5897:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5898:         $data{'realm'} = $1;
                   5899:         $data{'realm_type'} = 'folder';
                   5900:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5901:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5902:     } elsif ($middle) {
1.560     damieng  5903:         $data{'realm'} = $middle;
                   5904:         $data{'realm_type'} = 'symb';
                   5905:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5906:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5907:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5908:     }
1.446     bisitz   5909: 
1.333     albertel 5910:     $data{'parameter_part'} = $part;
                   5911:     $data{'parameter_name'} = $name;
                   5912: 
                   5913:     return %data;
                   5914: }
                   5915: 
1.239     raeburn  5916: 
1.563     damieng  5917: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5918: sub header {
1.507     www      5919:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5920: }
1.193     albertel 5921: 
                   5922: 
                   5923: 
1.560     damieng  5924: ##################################################
                   5925: # MAIN MENU
                   5926: ##################################################
                   5927: 
1.563     damieng  5928: # Content and problem settings main menu.
                   5929: #
                   5930: # @param {Apache2::RequestRec} $r - the Apache request
                   5931: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5932: sub print_main_menu {
                   5933:     my ($r,$parm_permission)=@_;
                   5934:     #
1.414     droeschl 5935:     $r->print(&header());
1.507     www      5936:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5937:     my $crstype = &Apache::loncommon::course_type();
                   5938:     my $lc_crstype = lc($crstype);
                   5939: 
                   5940:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5941:     $r->print(<<ENDMAINFORMHEAD);
                   5942: <form method="post" enctype="multipart/form-data"
                   5943:       action="/adm/parmset" name="studentform">
                   5944: ENDMAINFORMHEAD
                   5945: #
1.195     albertel 5946:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5947:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5948:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5949:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5950:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  5951:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   5952:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  5953:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5954:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5955:                                         '/'.$env{'request.course.sec'});
                   5956:     }
1.568     raeburn  5957:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   5958:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   5959:                                         '/'.$env{'request.course.sec'});
                   5960:     }
                   5961:     my (%linktext,%linktitle,%url);
                   5962:     if ($parm_permission->{'edit'}) {
                   5963:         %linktext = (
                   5964:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   5965:                      settable        => 'Edit Resource Parameters - Table Mode',
                   5966:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   5967:                     );
                   5968:         %linktitle = (
                   5969:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   5970:                      settable        => 'Set/Modify resource parameters in table mode.',
                   5971:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   5972:                      );
                   5973:     } else {
                   5974:         %linktext = (
                   5975:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   5976:                      settable        => 'View Resource Parameters - Table Mode',
                   5977:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   5978:                    );
                   5979:         %linktitle = (
                   5980:                      newoverview     => 'Display resource parameters in overview mode.',
                   5981:                      settable        => 'Display resource parameters in table mode.',
                   5982:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   5983:                      );
                   5984:     }
                   5985:     if ($mgr) {
                   5986:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   5987:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   5988:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   5989:     } elsif ($vgr) {
                   5990:         $linktext{'resettimes'} = 'Display Student Access Times',
                   5991:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   5992:         $url{'resettimes'} = '/adm/accesstimes';
                   5993:     }
1.193     albertel 5994:     my @menu =
1.507     www      5995:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5996:         items => [
                   5997:           { linktext => 'Portfolio Metadata',
                   5998:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  5999:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  6000:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 6001:             icon =>'contact-new.png'   ,
                   6002:             },
1.568     raeburn  6003:           { linktext => $linktext{'resettimes'},
                   6004:             url => $url{'resettimes'},
                   6005:             permission => ($vgr || $mgr),
                   6006:             linktitle => $linktitle{'resettimes'},
                   6007:             icon => 'start-here.png',
1.473     amueller 6008:             },
1.520     raeburn  6009:           { linktext => 'Blocking Communication/Resource Access',
                   6010:             url => '/adm/setblock',
1.568     raeburn  6011:             permission => ($vcb || $dcm),
1.520     raeburn  6012:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   6013:             icon => 'comblock.png',
                   6014:             },
1.473     amueller 6015:           { linktext => 'Set Parameter Setting Default Actions',
                   6016:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  6017:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 6018:             linktitle =>'Set default actions for parameters.'  ,
                   6019:             icon => 'folder-new.png'  ,
                   6020:             }]},
                   6021:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   6022:         items => [
                   6023:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   6024:             url => '/adm/helper/parameter.helper',
1.568     raeburn  6025:             permission => $parm_permission->{'helper'},
1.473     amueller 6026:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   6027:             icon => 'dialog-information.png'  ,
                   6028:             #help => 'Parameter_Helper',
                   6029:             },
1.568     raeburn  6030:           { linktext => $linktext{'newoverview'},
1.473     amueller 6031:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  6032:             permission => $parm_permission->{'newoverview'},
                   6033:             linktitle => $linktitle{'newoverview'},
                   6034:             icon => 'edit-find.png',
1.473     amueller 6035:             #help => 'Parameter_Overview',
                   6036:             },
1.568     raeburn  6037:           { linktext => $linktext{'settable'},
1.473     amueller 6038:             url => '/adm/parmset?action=settable',
1.568     raeburn  6039:             permission => $parm_permission->{'settable'},
                   6040:             linktitle => $linktitle{'settable'},
                   6041:             icon => 'edit-copy.png',
1.473     amueller 6042:             #help => 'Table_Mode',
                   6043:             }]},
1.417     droeschl 6044:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 6045:          items => [
1.570     raeburn  6046:           { linktext => $linktext{'setoverview'},
1.473     amueller 6047:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  6048:             permission => $parm_permission->{'setoverview'},
                   6049:             linktitle => $linktitle{'setoverview'},
                   6050:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 6051:             #help => 'Parameter_Overview',
                   6052:             },
                   6053:           { linktext => 'Change Log',
                   6054:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  6055:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  6056:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 6057:             icon => 'document-properties.png',
1.473     amueller 6058:             }]}
1.193     albertel 6059:           );
1.414     droeschl 6060:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  6061:     $r->print('</form>');
1.507     www      6062:     &endSettingsScreen($r);
1.539     raeburn  6063:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 6064:     return;
                   6065: }
1.414     droeschl 6066: 
1.416     jms      6067: 
                   6068: 
1.560     damieng  6069: ##################################################
                   6070: # PORTFOLIO METADATA
                   6071: ##################################################
                   6072: 
1.563     damieng  6073: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   6074: # It looks like field titles are not localized.
                   6075: #
                   6076: # @param {Apache2::RequestRec} $r - the Apache request
                   6077: # @param {string} $field_name - metadata field name
                   6078: # @param {string} $field_text - metadata field title, in English unless manually added
                   6079: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 6080: sub output_row {
1.347     banghart 6081:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 6082:     my $output;
1.263     banghart 6083:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   6084:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 6085:     if (!defined($options)) {
1.254     banghart 6086:         $options = 'active,stuadd';
1.261     banghart 6087:         $values = '';
1.252     banghart 6088:     }
1.337     banghart 6089:     if (!($options =~ /deleted/)) {
                   6090:         my @options= ( ['active', 'Show to student'],
1.418     schafran 6091:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 6092:                     ['choices','Provide choices for students to select from']);
1.473     amueller 6093: #           ['onlyone','Student may select only one choice']);
1.337     banghart 6094:         if ($added_flag) {
                   6095:             push @options,['deleted', 'Delete Metadata Field'];
                   6096:         }
1.351     banghart 6097:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   6098:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 6099:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 6100:         foreach my $opt (@options) {
1.560     damieng  6101:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   6102:             $output .= &Apache::loncommon::continue_data_table_row();
                   6103:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   6104:                     <input type="checkbox" name="'.
                   6105:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   6106:                     &mt($opt->[1]).'</label></td>';
                   6107:             $output .= &Apache::loncommon::end_data_table_row();
                   6108:         }
1.351     banghart 6109:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   6110:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 6111:         $output .= &Apache::loncommon::end_data_table_row();
                   6112:         my $multiple_checked;
                   6113:         my $single_checked;
                   6114:         if ($options =~ m/onlyone/) {
1.422     bisitz   6115:             $multiple_checked = '';
1.423     bisitz   6116:             $single_checked = ' checked="checked"';
1.351     banghart 6117:         } else {
1.423     bisitz   6118:             $multiple_checked = ' checked="checked"';
1.422     bisitz   6119:             $single_checked = '';
1.351     banghart 6120:         }
1.560     damieng  6121:         $output .= &Apache::loncommon::continue_data_table_row();
                   6122:         $output .= '<td>'.('&nbsp;' x 10).'
                   6123:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   6124:                     '.&mt('Student may select multiple choices from list').'</td>';
                   6125:         $output .= &Apache::loncommon::end_data_table_row();
                   6126:         $output .= &Apache::loncommon::continue_data_table_row();
                   6127:         $output .= '<td>'.('&nbsp;' x 10).'
                   6128:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   6129:                     '.&mt('Student may select only one choice from list').'</td>';
                   6130:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 6131:     }
                   6132:     return ($output);
                   6133: }
1.416     jms      6134: 
                   6135: 
1.560     damieng  6136: # UI to order portfolio metadata fields.
1.563     damieng  6137: # Currently useless because addmetafield does not work.
                   6138: #
                   6139: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 6140: sub order_meta_fields {
                   6141:     my ($r)=@_;
                   6142:     my $idx = 1;
                   6143:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6144:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6145:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 6146:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  6147:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6148:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6149:         text=>"Add Metadata Field"});
1.560     damieng  6150:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6151:         {href=>"/adm/parmset?action=setrestrictmeta",
                   6152:         text=>"Restrict Metadata"},
                   6153:         {text=>"Order Metadata"});
1.345     banghart 6154:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  6155:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 6156:     if ($env{'form.storeorder'}) {
                   6157:         my $newpos = $env{'form.newpos'} - 1;
                   6158:         my $currentpos = $env{'form.currentpos'} - 1;
                   6159:         my @neworder = ();
1.548     raeburn  6160:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6161:         my $i;
1.341     banghart 6162:         if ($newpos > $currentpos) {
1.340     banghart 6163:         # moving stuff up
                   6164:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  6165:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6166:             }
                   6167:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  6168:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 6169:             }
                   6170:             $neworder[$newpos]=$oldorder[$currentpos];
                   6171:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  6172:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6173:             }
                   6174:         } else {
                   6175:         # moving stuff down
1.473     amueller 6176:             for ($i=0;$i<$newpos;$i++) {
                   6177:                 $neworder[$i]=$oldorder[$i];
                   6178:             }
                   6179:             $neworder[$newpos]=$oldorder[$currentpos];
                   6180:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   6181:                 $neworder[$i]=$oldorder[$i-1];
                   6182:             }
                   6183:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   6184:                 $neworder[$i]=$oldorder[$i];
                   6185:             }
1.340     banghart 6186:         }
1.560     damieng  6187:         my $ordered_fields = join ",", @neworder;
1.343     banghart 6188:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  6189:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6190:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 6191:     }
1.357     raeburn  6192:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 6193:     my $ordered_fields;
1.548     raeburn  6194:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6195:     if (!@fields_in_order) {
                   6196:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  6197:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 6198:             push @fields_in_order, $key;
1.341     banghart 6199:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 6200:         }
1.341     banghart 6201:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   6202:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6203:     }
1.340     banghart 6204:     $r->print('<table>');
                   6205:     my $num_fields = scalar(@fields_in_order);
                   6206:     foreach my $key (@fields_in_order) {
                   6207:         $r->print('<tr><td>');
                   6208:         $r->print('<form method="post" action="">');
1.537     bisitz   6209:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 6210:         for (my $i = 1;$i le $num_fields;$i ++) {
                   6211:             if ($i eq $idx) {
                   6212:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   6213:             } else {
                   6214:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   6215:             }
                   6216:         }
                   6217:         $r->print('</select></td><td>');
                   6218:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   6219:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   6220:         $r->print('</form>');
                   6221:         $r->print($$fields{$key}.'</td></tr>');
                   6222:         $idx ++;
                   6223:     }
                   6224:     $r->print('</table>');
1.507     www      6225:     &endSettingsScreen($r);
1.340     banghart 6226:     return 'ok';
                   6227: }
1.416     jms      6228: 
                   6229: 
1.563     damieng  6230: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   6231: # @returns {string}
1.359     banghart 6232: sub continue {
                   6233:     my $output;
                   6234:     $output .= '<form action="" method="post">';
                   6235:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
1.586     raeburn  6236:     $output .= '<input type="submit" value="'.&mt('Continue').'" />';
1.359     banghart 6237:     return ($output);
                   6238: }
1.416     jms      6239: 
                   6240: 
1.563     damieng  6241: # UI to add a metadata field.
                   6242: # Currenly does not work because of an HTML error (the field is not visible).
                   6243: #
                   6244: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 6245: sub addmetafield {
                   6246:     my ($r)=@_;
1.414     droeschl 6247:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6248:         text=>"Add Metadata Field"});
1.334     banghart 6249:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   6250:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 6251:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6252:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6253:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6254:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 6255:     if (exists($env{'form.undelete'})) {
1.358     banghart 6256:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 6257:         foreach my $meta_field(@meta_fields) {
                   6258:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   6259:             $options =~ s/deleted//;
                   6260:             $options =~ s/,,/,/;
                   6261:             my $put_result = &Apache::lonnet::put('environment',
                   6262:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   6263: 
1.586     raeburn  6264:             $r->print(&mt('Undeleted Metadata Field [_1] with result [_2]',
                   6265:                           '<strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}.
                   6266:                           '</strong>',$put_result).
                   6267:                       '<br />');
1.339     banghart 6268:         }
1.359     banghart 6269:         $r->print(&continue());
1.339     banghart 6270:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 6271:         my $meta_field = $env{'form.fieldname'};
                   6272:         my $display_field = $env{'form.fieldname'};
                   6273:         $meta_field =~ s/\W/_/g;
1.338     banghart 6274:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 6275:         my $put_result = &Apache::lonnet::put('environment',
                   6276:                             {'metadata.'.$meta_field.'.values'=>"",
                   6277:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   6278:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.586     raeburn  6279:         $r->print(&mt('Added new Metadata Field [_1] with result [_2]',
                   6280:                       '<strong>'.$env{'form.fieldname'}.'</strong>',$put_result).
                   6281:                   '<br />');
1.359     banghart 6282:         $r->print(&continue());
1.335     banghart 6283:     } else {
1.357     raeburn  6284:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 6285:         if ($fields) {
1.586     raeburn  6286:             $r->print(&mt('You may undelete previously deleted fields.').
                   6287:                       '<br />'.
                   6288:                       &mt('Check those you wish to undelete and click Undelete.').
                   6289:                       '<br />');
1.339     banghart 6290:             $r->print('<form method="post" action="">');
                   6291:             foreach my $key(keys(%$fields)) {
1.581     raeburn  6292:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 6293:             }
1.586     raeburn  6294:             $r->print('<input type="submit" name="undelete" value="'.&mt('Undelete').'" />');
1.339     banghart 6295:             $r->print('</form>');
                   6296:         }
1.586     raeburn  6297:         $r->print('<hr />'.
                   6298:                   &mt('[_1]Or[_2] you may enter a new metadata field name.',
                   6299:                       '<strong>','</strong>').
1.581     raeburn  6300:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 6301:         $r->print('<input type="text" name="fieldname" /><br />');
1.586     raeburn  6302:         $r->print('<input type="submit" value="'.&mt('Add Metadata Field').'" />');
1.581     raeburn  6303:         $r->print('</form>');
1.334     banghart 6304:     }
1.507     www      6305:     &endSettingsScreen($r);
1.334     banghart 6306: }
1.416     jms      6307: 
                   6308: 
                   6309: 
1.560     damieng  6310: # Display or save portfolio metadata.
1.563     damieng  6311: #
                   6312: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 6313: sub setrestrictmeta {
1.240     banghart 6314:     my ($r)=@_;
1.242     banghart 6315:     my $next_meta;
1.244     banghart 6316:     my $output;
1.245     banghart 6317:     my $item_num;
1.246     banghart 6318:     my $put_result;
1.414     droeschl 6319:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 6320:         text=>"Restrict Metadata"});
1.280     albertel 6321:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 6322:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 6323:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6324:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6325:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6326:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 6327:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 6328:     my $save_field = '';
1.586     raeburn  6329:     my %lt = &Apache::lonlocal::texthash(
                   6330:                                            addm => 'Add Metadata Field',
                   6331:                                            ordm => 'Order Metadata Fields',
                   6332:                                            save => 'Save',
                   6333:                                         );
1.259     banghart 6334:     if ($env{'form.restrictmeta'}) {
1.254     banghart 6335:         foreach my $field (sort(keys(%env))) {
1.252     banghart 6336:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 6337:                 my $options;
1.252     banghart 6338:                 my $meta_field = $1;
                   6339:                 my $meta_key = $2;
1.253     banghart 6340:                 if ($save_field ne $meta_field) {
1.252     banghart 6341:                     $save_field = $meta_field;
1.473     amueller 6342:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   6343:                         $options.='stuadd,';
                   6344:                     }
                   6345:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   6346:                         $options.='choices,';
                   6347:                     }
                   6348:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   6349:                         $options.='onlyone,';
                   6350:                     }
                   6351:                     if ($env{'form.'.$meta_field.'_active'}) {
                   6352:                         $options.='active,';
                   6353:                     }
                   6354:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   6355:                         $options.='deleted,';
                   6356:                     }
1.259     banghart 6357:                     my $name = $save_field;
1.560     damieng  6358:                     $put_result = &Apache::lonnet::put('environment',
                   6359:                         {'metadata.'.$meta_field.'.options'=>$options,
                   6360:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   6361:                         },$dom,$crs);
1.252     banghart 6362:                 }
                   6363:             }
                   6364:         }
                   6365:     }
1.296     albertel 6366:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 6367:                        {'freshen_cache' => 1});
1.335     banghart 6368:     # Get the default metadata fields
1.258     albertel 6369:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 6370:     # Now get possible added metadata fields
1.357     raeburn  6371:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.347     banghart 6372:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 6373:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 6374:         if ($field ne 'courserestricted') {
1.586     raeburn  6375:             $output.= &output_row($r,$field,$metadata_fields{$field});
1.560     damieng  6376:         }
1.255     banghart 6377:     }
1.351     banghart 6378:     my $buttons = (<<ENDButtons);
1.586     raeburn  6379:         <input type="submit" name="restrictmeta" value="$lt{'save'}" />
1.351     banghart 6380:         </form><br />
                   6381:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
1.586     raeburn  6382:         <input type="submit" name="restrictmeta" value="$lt{'addm'}" />
1.351     banghart 6383:         </form>
                   6384:         <br />
                   6385:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
1.586     raeburn  6386:         <input type="submit" name="restrictmeta" value="$lt{'ordm'}" />
1.351     banghart 6387: ENDButtons
1.337     banghart 6388:     my $added_flag = 1;
1.335     banghart 6389:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.586     raeburn  6390:         $output.= &output_row($r,$field,$$added_metadata_fields{$field},$added_flag);
1.335     banghart 6391:     }
1.347     banghart 6392:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   6393:     $r->print(<<ENDenv);
1.259     banghart 6394:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 6395:         $output
1.351     banghart 6396:         $buttons
1.340     banghart 6397:         </form>
1.244     banghart 6398: ENDenv
1.507     www      6399:     &endSettingsScreen($r);
1.280     albertel 6400:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 6401:     return 'ok';
                   6402: }
1.416     jms      6403: 
                   6404: 
1.563     damieng  6405: # Returns metadata fields that have been manually added.
                   6406: #
                   6407: # @param {string} $cid - course id
                   6408: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 6409: sub get_added_meta_fieldnames {
1.357     raeburn  6410:     my ($cid) = @_;
1.335     banghart 6411:     my %fields;
                   6412:     foreach my $key(%env) {
1.357     raeburn  6413:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 6414:             my $field_name = $1;
                   6415:             my ($display_field_name) = $env{$key};
                   6416:             $fields{$field_name} = $display_field_name;
                   6417:         }
                   6418:     }
                   6419:     return \%fields;
                   6420: }
1.416     jms      6421: 
                   6422: 
1.563     damieng  6423: # Returns metadata fields that have been manually added and deleted.
                   6424: #
                   6425: # @param {string} $cid - course id
                   6426: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 6427: sub get_deleted_meta_fieldnames {
1.357     raeburn  6428:     my ($cid) = @_;
1.339     banghart 6429:     my %fields;
                   6430:     foreach my $key(%env) {
1.357     raeburn  6431:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 6432:             my $field_name = $1;
                   6433:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   6434:                 my ($display_field_name) = $env{$key};
                   6435:                 $fields{$field_name} = $display_field_name;
                   6436:             }
                   6437:         }
                   6438:     }
                   6439:     return \%fields;
                   6440: }
1.560     damieng  6441: 
                   6442: 
                   6443: ##################################################
                   6444: # PARAMETER SETTINGS DEFAULT ACTIONS
                   6445: ##################################################
                   6446: 
                   6447: # UI to change parameter setting default actions
1.563     damieng  6448: #
                   6449: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6450: sub defaultsetter {
1.280     albertel 6451:     my ($r) = @_;
                   6452: 
1.414     droeschl 6453:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6454:         text=>"Set Defaults"});
1.531     raeburn  6455:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6456:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6457:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6458:     my $start_page =
1.531     raeburn  6459:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6460:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6461:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6462:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6463:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6464: 
1.221     www      6465:     my @ids=();
                   6466:     my %typep=();
                   6467:     my %keyp=();
                   6468:     my %allparms=();
                   6469:     my %allparts=();
                   6470:     my %allmaps=();
                   6471:     my %mapp=();
                   6472:     my %symbp=();
                   6473:     my %maptitles=();
                   6474:     my %uris=();
                   6475:     my %keyorder=&standardkeyorder();
                   6476:     my %defkeytype=();
                   6477: 
1.446     bisitz   6478:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6479:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6480:                 \%keyorder,\%defkeytype);
1.224     www      6481:     if ($env{'form.storerules'}) {
1.560     damieng  6482:         my %newrules=();
                   6483:         my @delrules=();
                   6484:         my %triggers=();
                   6485:         foreach my $key (keys(%env)) {
1.225     albertel 6486:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6487:                 my $tempkey=$1;
                   6488:                 my $action=$env{$key};
1.226     www      6489:                 if ($action) {
1.560     damieng  6490:                     $newrules{$tempkey.'_action'}=$action;
                   6491:                     if ($action ne 'default') {
                   6492:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6493:                         $triggers{$whichparm}.=$tempkey.':';
                   6494:                     }
                   6495:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6496:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6497:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6498:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6499:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6500:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6501:                     } else {
                   6502:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6503:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6504:                     }
                   6505:                 } else {
                   6506:                     push(@delrules,$tempkey.'_action');
                   6507:                     push(@delrules,$tempkey.'_type');
                   6508:                     push(@delrules,$tempkey.'_hours');
                   6509:                     push(@delrules,$tempkey.'_min');
                   6510:                     push(@delrules,$tempkey.'_sec');
                   6511:                     push(@delrules,$tempkey.'_value');
                   6512:                 }
1.473     amueller 6513:             }
                   6514:         }
1.560     damieng  6515:         foreach my $key (keys(%allparms)) {
                   6516:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6517:         }
1.560     damieng  6518:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6519:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6520:         &resetrulescache();
1.224     www      6521:     }
1.227     www      6522:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6523:                        'hours' => 'Hours',
                   6524:                        'min' => 'Minutes',
                   6525:                        'sec' => 'Seconds',
                   6526:                        'yes' => 'Yes',
                   6527:                        'no' => 'No');
1.222     www      6528:     my @standardoptions=('','default');
                   6529:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6530:     my @dateoptions=('','default');
                   6531:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6532:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6533:         unless ($tempkey) { next; }
                   6534:         push @standardoptions,'when_setting_'.$tempkey;
                   6535:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6536:         if (&isdateparm($defkeytype{$tempkey})) {
                   6537:             push @dateoptions,'later_than_'.$tempkey;
                   6538:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6539:             push @dateoptions,'earlier_than_'.$tempkey;
                   6540:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6541:         }
1.222     www      6542:     }
1.563     damieng  6543:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6544:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6545:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6546:           &Apache::loncommon::start_data_table_header_row().
                   6547:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6548:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6549:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6550:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6551:         unless ($tempkey) { next; }
                   6552:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6553:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6554:         my $action=&rulescache($tempkey.'_action');
                   6555:         $r->print('<select name="'.$tempkey.'_action">');
                   6556:         if (&isdateparm($defkeytype{$tempkey})) {
                   6557:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6558:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6559:             $r->print("\n<option value='$dateoptions[$i]'".
                   6560:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6561:                 ">$datedisplay[$i]</option>");
                   6562:             }
                   6563:         } else {
                   6564:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6565:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6566:             $r->print("\n<option value='$standardoptions[$i]'".
                   6567:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6568:                 ">$standarddisplay[$i]</option>");
                   6569:             }
1.473     amueller 6570:         }
1.560     damieng  6571:         $r->print('</select>');
                   6572:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6573:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6574:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6575:         }
1.560     damieng  6576:         $r->print("\n</td><td>\n");
1.222     www      6577: 
1.221     www      6578:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6579:             my $days=&rulescache($tempkey.'_days');
                   6580:             my $hours=&rulescache($tempkey.'_hours');
                   6581:             my $min=&rulescache($tempkey.'_min');
                   6582:             my $sec=&rulescache($tempkey.'_sec');
                   6583:             $r->print(<<ENDINPUTDATE);
                   6584:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6585:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6586:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6587:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6588: ENDINPUTDATE
1.560     damieng  6589:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6590:                 my $yeschecked='';
                   6591:                 my $nochecked='';
                   6592:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6593:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6594: 
                   6595:             $r->print(<<ENDYESNO);
                   6596:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6597:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6598: ENDYESNO
1.221     www      6599:         } else {
1.560     damieng  6600:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6601:         }
1.318     albertel 6602:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6603:     }
1.318     albertel 6604:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6605:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6606:           &mt('Save').'" /></form>'."\n");
                   6607:     &endSettingsScreen($r);
                   6608:     $r->print(&Apache::loncommon::end_page());
1.220     www      6609:     return;
                   6610: }
1.193     albertel 6611: 
1.560     damieng  6612: ##################################################
                   6613: # PARAMETER CHANGES LOG
                   6614: ##################################################
                   6615: 
1.563     damieng  6616: # Returns some info for a parameter log entry.
                   6617: # Returned entries:
                   6618: # $realm - HTML title for the parameter level and resource
                   6619: # $section - parameter section
                   6620: # $name - parameter name
                   6621: # $part - parameter part
                   6622: # $what - $part.'.'.$name
                   6623: # $middle - resource symb ?
                   6624: # $uname - user name (same as given)
                   6625: # $udom - user domain (same as given)
                   6626: # $issection - section or group name
                   6627: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6628: #
                   6629: # @param {string} $key - parameter log key
                   6630: # @param {string} $uname - user name
                   6631: # @param {string} $udom - user domain
                   6632: # @param {boolean} $typeflag - .type log entry
                   6633: # @returns {Array}
1.290     www      6634: sub components {
1.581     raeburn  6635:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6636: 
                   6637:     if ($typeflag) {
1.560     damieng  6638:         $key=~s/\.type$//;
1.290     www      6639:     }
1.330     albertel 6640: 
                   6641:     my ($middle,$part,$name)=
1.572     damieng  6642:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6643:     my $issection;
1.330     albertel 6644: 
1.290     www      6645:     my $section=&mt('All Students');
                   6646:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6647:         $issection=$1;
                   6648:         $section=&mt('Group/Section').': '.$issection;
                   6649:         $middle=~s/^\[(.*)\]//;
1.290     www      6650:     }
                   6651:     $middle=~s/\.+$//;
                   6652:     $middle=~s/^\.+//;
1.291     www      6653:     if ($uname) {
1.560     damieng  6654:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6655:         $issection='';
1.291     www      6656:     }
1.316     albertel 6657:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6658:     my $realmdescription=&mt('all resources');
1.556     raeburn  6659:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6660:         my $mapurl = $1;
                   6661:         my $maplevel = $2;
                   6662:         my $leveltitle = &mt('Folder/Map');
                   6663:         if ($maplevel eq 'rec') {
                   6664:             $leveltitle = &mt('Recursive');
                   6665:         }
1.560     damieng  6666:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6667:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6668:             $mapurl.')</span></span>';
                   6669:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6670:     } elsif ($middle) {
                   6671:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6672:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6673:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6674:             ' in '.$map.' id: '.$id.')</span></span>';
                   6675:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6676:     }
1.291     www      6677:     my $what=$part.'.'.$name;
1.330     albertel 6678:     return ($realm,$section,$name,$part,
1.473     amueller 6679:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6680: }
1.293     www      6681: 
1.563     damieng  6682: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6683: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6684: 
1.563     damieng  6685: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6686: sub load_parameter_names {
1.583     raeburn  6687:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 6688:     while (my $configline=<$config>) {
1.560     damieng  6689:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6690:         chomp($configline);
                   6691:         my ($short,$plain)=split(/:/,$configline);
                   6692:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6693:         if ($type eq 'display') {
                   6694:             $standard_parms{$name} = $plain;
1.469     raeburn  6695:         } elsif ($type eq 'type') {
1.560     damieng  6696:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6697:         }
1.328     albertel 6698:     }
                   6699:     close($config);
                   6700:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6701:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6702:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6703: }
                   6704: 
1.563     damieng  6705: # Returns a parameter title for standard parameters, the name for others.
                   6706: #
                   6707: # @param {string} $name - parameter name
                   6708: # @returns {string}
1.292     www      6709: sub standard_parameter_names {
                   6710:     my ($name)=@_;
1.328     albertel 6711:     if (!%standard_parms) {
1.560     damieng  6712:         &load_parameter_names();
1.328     albertel 6713:     }
1.292     www      6714:     if ($standard_parms{$name}) {
1.560     damieng  6715:         return $standard_parms{$name};
1.446     bisitz   6716:     } else {
1.560     damieng  6717:         return $name;
1.292     www      6718:     }
                   6719: }
1.290     www      6720: 
1.563     damieng  6721: # Returns a parameter type for standard parameters, undef for others.
                   6722: #
                   6723: # @param {string} $name - parameter name
                   6724: # @returns {string}
1.469     raeburn  6725: sub standard_parameter_types {
                   6726:     my ($name)=@_;
                   6727:     if (!%standard_parms_types) {
                   6728:         &load_parameter_names();
                   6729:     }
                   6730:     if ($standard_parms_types{$name}) {
                   6731:         return $standard_parms_types{$name};
                   6732:     }
                   6733:     return;
                   6734: }
1.309     www      6735: 
1.563     damieng  6736: # Returns a parameter level title (not localized) from the parameter level name.
                   6737: #
                   6738: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6739: # @returns {string}
1.557     raeburn  6740: sub standard_parameter_levels {
                   6741:     my ($name)=@_;
                   6742:     my %levels = (
                   6743:                     'resourcelevel'   => 'a single resource',
                   6744:                     'maplevel'        => 'the enclosing map/folder', 
                   6745:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6746:                     'courselevel'     => 'the general (course) level',
                   6747:                  );
                   6748:     if ($levels{$name}) {
                   6749:         return $levels{$name};
                   6750:     }
                   6751:     return;
                   6752: }
                   6753: 
1.560     damieng  6754: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6755: #
                   6756: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6757: sub parm_change_log {
1.568     raeburn  6758:     my ($r,$parm_permission)=@_;
1.531     raeburn  6759:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6760:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6761:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6762:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6763:     text=>"Parameter Change Log"});
1.522     raeburn  6764:     my $js = '<script type="text/javascript">'."\n".
                   6765:              '// <![CDATA['."\n".
                   6766:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6767:              '// ]]>'."\n".
                   6768:              '</script>'."\n";
                   6769:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6770:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6771:     &startSettingsScreen($r,'parmset',$crstype);
                   6772:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6773: 
1.301     www      6774:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6775: 
1.522     raeburn  6776:     $r->print('<div class="LC_left_float">'.
                   6777:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6778:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6779:                      method="post" name="parameterlog">');
1.446     bisitz   6780: 
1.311     albertel 6781:     my %saveable_parameters = ('show' => 'scalar',);
                   6782:     &Apache::loncommon::store_course_settings('parameter_log',
                   6783:                                               \%saveable_parameters);
                   6784:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6785:                                                 \%saveable_parameters);
1.522     raeburn  6786:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6787:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6788:               '</form></fieldset></div><br clear="all" />');
1.301     www      6789: 
1.568     raeburn  6790:     my $readonly = 1;
                   6791:     if ($parm_permission->{'edit'}) {
                   6792:         undef($readonly);
                   6793:     }
1.531     raeburn  6794:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6795:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6796:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6797:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6798:     unless ($readonly) {
                   6799:         $r->print('<th>'.&mt('Announce').'</th>');
                   6800:     }
                   6801:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6802:     my $shown=0;
1.349     www      6803:     my $folder='';
                   6804:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6805:         my $last='';
                   6806:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6807:                 &GDBM_READER(),0640)) {
                   6808:             $last=$hash{'last_known'};
                   6809:             untie(%hash);
                   6810:         }
                   6811:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6812:     }
                   6813:     foreach my $id (sort {
                   6814:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6815:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6816:                 }
                   6817:                 my $aid = (split('00000',$a))[-1];
                   6818:                 my $bid = (split('00000',$b))[-1];
                   6819:                 return $bid<=>$aid;
1.473     amueller 6820:             } (keys(%parmlog))) {
1.294     www      6821:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6822:         my $count = 0;
                   6823:         my $time =
                   6824:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6825:         my $plainname =
                   6826:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6827:                         $parmlog{$id}{'exe_udom'});
                   6828:         my $about_me_link =
                   6829:             &Apache::loncommon::aboutmewrapper($plainname,
                   6830:                             $parmlog{$id}{'exe_uname'},
                   6831:                             $parmlog{$id}{'exe_udom'});
                   6832:         my $send_msg_link='';
1.568     raeburn  6833:         if ((!$readonly) && 
                   6834:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6835:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6836:             $send_msg_link ='<br />'.
                   6837:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6838:                             $parmlog{$id}{'exe_uname'},
                   6839:                             $parmlog{$id}{'exe_udom'});
                   6840:         }
                   6841:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6842:         my $makenewrow=0;
                   6843:         my %istype=();
                   6844:         my $output;
                   6845:         foreach my $changed (reverse(sort(@changes))) {
                   6846:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6847:             my $typeflag = ($changed =~/\.type$/ &&
                   6848:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6849:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581     raeburn  6850:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6851:             if ($env{'request.course.sec'} ne '') {
                   6852:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6853:                 if ($uname ne '') {
                   6854:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6855:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6856:                 }
                   6857:             }
                   6858:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6859:                 if ($folder) {
                   6860:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6861:                 }
                   6862:             }
                   6863:             if ($typeflag) {
                   6864:                 $istype{$parmname}=$value;
                   6865:                 if (!$env{'form.includetypes'}) { next; }
                   6866:             }
                   6867:             $count++;
                   6868:             if ($makenewrow) {
                   6869:                 $output .= $row_start;
                   6870:             } else {
                   6871:                 $makenewrow=1;
                   6872:             }
1.470     raeburn  6873:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6874:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6875:                 &mt($parmitem).'</td><td>'.
                   6876:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6877:             my $stillactive=0;
                   6878:             if ($parmlog{$id}{'delflag'}) {
                   6879:                 $output .= &mt('Deleted');
                   6880:             } else {
                   6881:                 if ($typeflag) {
1.470     raeburn  6882:                     my $parmitem = &standard_parameter_names($value); 
                   6883:                     $parmitem = &mt($parmitem);
1.560     damieng  6884:                     $output .= &mt('Type: [_1]',$parmitem);
                   6885:                 } else {
1.584     raeburn  6886:                     my $toolsymb;
                   6887:                     if ($middle =~ /ext\.tool$/) {
                   6888:                         $toolsymb = $middle;
                   6889:                     }
1.560     damieng  6890:                     my ($level,@all)=&parmval_by_symb($what,$middle,
1.584     raeburn  6891:                         &Apache::lonnet::metadata($middle,$what,$toolsymb),
1.560     damieng  6892:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6893:                     my $showvalue = $value;
                   6894:                     if ($istype{$parmname} eq '') {
                   6895:                         my $type = &standard_parameter_types($parmname);
                   6896:                         if ($type ne '') {
                   6897:                             if (&isdateparm($type)) {
                   6898:                                 $showvalue =
                   6899:                                     &Apache::lonlocal::locallocaltime($value);
                   6900:                             }
                   6901:                         }
                   6902:                     } else {
1.560     damieng  6903:                         if (&isdateparm($istype{$parmname})) {
                   6904:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6905:                         }
1.469     raeburn  6906:                     }
                   6907:                     $output .= $showvalue;
1.560     damieng  6908:                     if ($value ne $all[$level]) {
                   6909:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6910:                     } else {
                   6911:                         $stillactive=1;
                   6912:                     }
                   6913:                 }
1.473     amueller 6914:             }
1.568     raeburn  6915:             $output .= '</td>';
                   6916: 
                   6917:             unless ($readonly) { 
                   6918:                 $output .= '<td>';
                   6919:                 if ($stillactive) {
                   6920:                     my $parmitem = &standard_parameter_names($parmname);
                   6921:                     $parmitem = &mt($parmitem);
                   6922:                     my $title=&mt('Changed [_1]',$parmitem);
                   6923:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   6924:                         $parmitem,$realmdescription,
                   6925:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   6926:                     if (($uname) && ($udom)) {
                   6927:                         $output .=
                   6928:                         &Apache::loncommon::messagewrapper('Notify User',
                   6929:                                                            $uname,$udom,$title,
                   6930:                                                            $description);
                   6931:                     } else {
                   6932:                         $output .=
                   6933:                             &Apache::lonrss::course_blog_link($id,$title,
                   6934:                                                               $description);
                   6935:                     }
1.560     damieng  6936:                 }
1.568     raeburn  6937:                 $output .= '</td>';
1.560     damieng  6938:             }
1.568     raeburn  6939:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 6940:         }
1.560     damieng  6941:         if ($env{'form.displayfilter'} eq 'containing') {
                   6942:             my $wholeentry=$about_me_link.':'.
                   6943:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6944:             $output;
                   6945:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6946:         }
1.349     www      6947:         if ($count) {
1.560     damieng  6948:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6949:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6950:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6951:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6952:             $send_msg_link.'</td>'.$output);
                   6953:             $shown++;
                   6954:         }
                   6955:         if (!($env{'form.show'} eq &mt('all')
                   6956:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6957:     }
1.301     www      6958:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6959:     &endSettingsScreen($r);
1.284     www      6960:     $r->print(&Apache::loncommon::end_page());
                   6961: }
                   6962: 
1.560     damieng  6963: ##################################################
                   6964: # MISC !
                   6965: ##################################################
                   6966: 
1.563     damieng  6967: # Stores slot information.
1.560     damieng  6968: # Used by table UI
1.563     damieng  6969: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6970: #
                   6971: # @param {string} $slot_name - slot name
                   6972: # @param {string} $cdom - course domain
                   6973: # @param {string} $cnum - course number
                   6974: # @param {string} $symb - resource symb
                   6975: # @param {string} $uname - user name
                   6976: # @param {string} $udom - user domain
                   6977: # @returns {string} - 'ok' or error name
1.437     raeburn  6978: sub update_slots {
                   6979:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6980:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6981:     if (!keys(%slot)) {
                   6982:         return 'error: slot does not exist';
                   6983:     }
                   6984:     my $max=$slot{'maxspace'};
                   6985:     if (!defined($max)) { $max=99999; }
                   6986: 
                   6987:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6988:                                        "^$slot_name\0");
                   6989:     my ($tmp)=%consumed;
                   6990:     if ($tmp=~/^error: 2 / ) {
                   6991:         return 'error: unable to determine current slot status';
                   6992:     }
                   6993:     my $last=0;
                   6994:     foreach my $key (keys(%consumed)) {
                   6995:         my $num=(split('\0',$key))[1];
                   6996:         if ($num > $last) { $last=$num; }
                   6997:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6998:             return 'ok';
                   6999:         }
                   7000:     }
                   7001: 
                   7002:     if (scalar(keys(%consumed)) >= $max) {
                   7003:         return 'error: no space left in slot';
                   7004:     }
                   7005:     my $wanted=$last+1;
                   7006: 
                   7007:     my %reservation=('name'      => $uname.':'.$udom,
                   7008:                      'timestamp' => time,
                   7009:                      'symb'      => $symb);
                   7010: 
                   7011:     my $success=&Apache::lonnet::newput('slot_reservations',
                   7012:                                         {"$slot_name\0$wanted" =>
                   7013:                                              \%reservation},
                   7014:                                         $cdom, $cnum);
1.438     raeburn  7015:     if ($success eq 'ok') {
                   7016:         my %storehash = (
                   7017:                           symb    => $symb,
                   7018:                           slot    => $slot_name,
                   7019:                           action  => 'reserve',
                   7020:                           context => 'parameter',
                   7021:                         );
1.526     raeburn  7022:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7023:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  7024: 
1.526     raeburn  7025:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7026:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  7027:     }
1.437     raeburn  7028:     return $success;
                   7029: }
                   7030: 
1.563     damieng  7031: # Deletes a slot reservation.
1.560     damieng  7032: # Used by table UI
1.563     damieng  7033: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   7034: #
                   7035: # @param {string} $slot_name - slot name
                   7036: # @param {string} $cdom - course domain
                   7037: # @param {string} $cnum - course number
                   7038: # @param {string} $uname - user name
                   7039: # @param {string} $udom - user domain
                   7040: # @param {string} $symb - resource symb
                   7041: # @returns {string} - 'ok' or error name
1.437     raeburn  7042: sub delete_slots {
                   7043:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   7044:     my $delresult;
                   7045:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   7046:                                          $cnum, "^$slot_name\0");
                   7047:     if (&Apache::lonnet::error(%consumed)) {
                   7048:         return 'error: unable to determine current slot status';
                   7049:     }
                   7050:     my ($tmp)=%consumed;
                   7051:     if ($tmp=~/^error: 2 /) {
                   7052:         return 'error: unable to determine current slot status';
                   7053:     }
                   7054:     foreach my $key (keys(%consumed)) {
                   7055:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   7056:             my $num=(split('\0',$key))[1];
                   7057:             my $entry = $slot_name.'\0'.$num;
                   7058:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   7059:                                               $cdom,$cnum);
                   7060:             if ($delresult eq 'ok') {
                   7061:                 my %storehash = (
                   7062:                                   symb    => $symb,
                   7063:                                   slot    => $slot_name,
                   7064:                                   action  => 'release',
                   7065:                                   context => 'parameter',
                   7066:                                 );
1.526     raeburn  7067:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7068:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  7069:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7070:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  7071:             }
                   7072:         }
                   7073:     }
                   7074:     return $delresult;
                   7075: }
                   7076: 
1.563     damieng  7077: # Returns true if there is a current course.
1.560     damieng  7078: # Used by handler
1.563     damieng  7079: #
                   7080: # @returns {boolean}
1.355     albertel 7081: sub check_for_course_info {
                   7082:     my $navmap = Apache::lonnavmaps::navmap->new();
                   7083:     return 1 if ($navmap);
                   7084:     return 0;
                   7085: }
                   7086: 
1.563     damieng  7087: # Returns the current course host and host LON-CAPA version.
                   7088: #
                   7089: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  7090: sub parameter_release_vars { 
1.504     raeburn  7091:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7092:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   7093:    my $chostname = &Apache::lonnet::hostname($chome);
                   7094:    my ($cmajor,$cminor) = 
                   7095:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   7096:    return ($chostname,$cmajor,$cminor);
                   7097: }
                   7098: 
1.563     damieng  7099: # Checks if the course host version can handle a parameter required version,
                   7100: # and if it does, stores the release needed for the course.
                   7101: #
                   7102: # @param {string} $name - parameter name
                   7103: # @param {string} $value - parameter value
                   7104: # @param {string} $valmatch - name of the test used for checking the value
                   7105: # @param {string} $namematch - name of the test used for checking the name
                   7106: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   7107: # @param {integer} $cmajor - course major version number
                   7108: # @param {integer} $cminor - course minor version number
                   7109: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  7110: sub parameter_releasecheck {
1.557     raeburn  7111:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  7112:     my $needsnewer;
                   7113:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   7114:     if (($cmajor < $needsmajor) || 
                   7115:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   7116:         $needsnewer = 1;
1.557     raeburn  7117:     } elsif ($name) {
                   7118:         if ($valmatch) {
                   7119:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   7120:         } elsif ($value) { 
                   7121:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   7122:         }
                   7123:     } elsif ($namematch) {
                   7124:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  7125:     }
                   7126:     return $needsnewer;
                   7127: }
                   7128: 
1.568     raeburn  7129: sub get_permission {
                   7130:     my %permission;
                   7131:     my $allowed = 0;
                   7132:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   7133:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   7134:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   7135:                   $env{'request.course.sec'}))) {
                   7136:         %permission= (
                   7137:                        'edit'               => 1,
                   7138:                        'set'                => 1,
                   7139:                        'setoverview'        => 1,
                   7140:                        'addmetadata'        => 1,
                   7141:                        'ordermetadata'      => 1,
                   7142:                        'setrestrictmeta'    => 1,
                   7143:                        'newoverview'        => 1,
                   7144:                        'setdefaults'        => 1,
                   7145:                        'settable'           => 1,
                   7146:                        'parameterchangelog' => 1,
                   7147:                        'cleanparameters'    => 1,
                   7148:                        'dateshift1'         => 1,
                   7149:                        'dateshift2'         => 1,
                   7150:                        'helper'             => 1,
                   7151:          );
                   7152:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   7153:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   7154:                   $env{'request.course.sec'}))) {
                   7155:         %permission = (
                   7156:                        'set'                => 1,
                   7157:                        'settable'           => 1,
                   7158:                        'newoverview'        => 1,
                   7159:                        'setoverview'        => 1,
                   7160:                        'parameterchangelog' => 1,
                   7161:                       );
                   7162:     }
                   7163:     foreach my $perm (values(%permission)) {
                   7164:         if ($perm) { $allowed=1; last; }
                   7165:     }
                   7166:     return (\%permission,$allowed);
                   7167: }
                   7168: 
1.560     damieng  7169: ##################################################
                   7170: # HANDLER
                   7171: ##################################################
                   7172: 
                   7173: # Main handler for lonparmset.
                   7174: # Sub called based on request parameters action and command:
                   7175: # no command or action: print_main_menu
                   7176: # command 'set': assessparms (direct access to table mode for a resource)
                   7177: #                (this can also be accessed simply with the symb parameter)
                   7178: # action 'setoverview': overview (display all existing parameter settings)
                   7179: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   7180: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   7181: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   7182: # action 'newoverview': newoverview (overview mode)
                   7183: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   7184: # action 'settable': assessparms (table mode)
                   7185: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   7186: #                              blog postings, user notification changes)
                   7187: # action 'cleanparameters': clean_parameters (unused)
                   7188: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   7189: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      7190: sub handler {
1.43      albertel 7191:     my $r=shift;
1.30      www      7192: 
1.376     albertel 7193:     &reset_caches();
                   7194: 
1.414     droeschl 7195:     &Apache::loncommon::content_type($r,'text/html');
                   7196:     $r->send_http_header;
                   7197:     return OK if $r->header_only;
                   7198: 
1.193     albertel 7199:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 7200:                         ['action','state',
1.205     www      7201:                                              'pres_marker',
                   7202:                                              'pres_value',
1.206     www      7203:                                              'pres_type',
1.506     www      7204:                                              'filter','part',
1.390     www      7205:                                              'udom','uname','symb','serial','timebase']);
1.131     www      7206: 
1.83      bowersj2 7207: 
1.193     albertel 7208:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 7209:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      7210:                         text=>"Content and Problem Settings",
1.473     amueller 7211:                         faq=>10,
                   7212:                         bug=>'Instructor Interface',
1.442     droeschl 7213:                                             help =>
                   7214:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      7215: 
1.30      www      7216: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  7217:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 7218:     my $exists = &check_for_course_info();
                   7219: 
1.568     raeburn  7220:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 7221:         #
                   7222:         # Main switch on form.action and form.state, as appropriate
                   7223:         #
                   7224:         # Check first if coming from someone else headed directly for
                   7225:         #  the table mode
1.568     raeburn  7226:         if (($parm_permission->{'set'}) && 
                   7227:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   7228:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   7229:             &assessparms($r,$parm_permission);
1.193     albertel 7230:         } elsif (! exists($env{'form.action'})) {
                   7231:             &print_main_menu($r,$parm_permission);
1.568     raeburn  7232:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   7233:             &print_main_menu($r,$parm_permission);
1.414     droeschl 7234:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  7235:             &overview($r,$parm_permission);
1.560     damieng  7236:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   7237:             &addmetafield($r);
                   7238:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   7239:             &order_meta_fields($r);
1.414     droeschl 7240:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  7241:             &setrestrictmeta($r);
1.414     droeschl 7242:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  7243:             &newoverview($r,$parm_permission);
1.414     droeschl 7244:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  7245:             &defaultsetter($r);
                   7246:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  7247:             &assessparms($r,$parm_permission);
1.414     droeschl 7248:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  7249:             &parm_change_log($r,$parm_permission);
1.414     droeschl 7250:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  7251:             &clean_parameters($r);
1.414     droeschl 7252:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      7253:             &date_shift_one($r);
1.414     droeschl 7254:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      7255:             &date_shift_two($r);
1.446     bisitz   7256:         }
1.43      albertel 7257:     } else {
1.1       www      7258: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  7259:         if ($exists) {
                   7260:             $env{'user.error.msg'}=
                   7261:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   7262:         } else {
                   7263:             $env{'user.error.msg'}=
                   7264:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   7265:         }
                   7266:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 7267:     }
1.376     albertel 7268:     &reset_caches();
                   7269: 
1.43      albertel 7270:     return OK;
1.1       www      7271: }
                   7272: 
                   7273: 1;
                   7274: __END__
                   7275: 
                   7276: 

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