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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.593   ! raeburn     4: # $Id: lonparmset.pm,v 1.592 2019/04/09 13:45:57 raeburn Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
1.579     raeburn    39: lonparmset provides an interface to setting content parameters in a 
                     40: course.
1.560     damieng    41: 
                     42: It contains all the code for the "Content and Problem Settings" UI, except
                     43: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
                     44: and lonblockingmenu.pm.
1.59      matthew    45: 
                     46: =head1 DESCRIPTION
                     47: 
                     48: This module sets coursewide and assessment parameters.
                     49: 
                     50: =head1 INTERNAL SUBROUTINES
                     51: 
1.416     jms        52: =over
1.59      matthew    53: 
1.416     jms        54: =item parmval()
1.59      matthew    55: 
                     56: Figure out a cascading parameter.
                     57: 
1.71      albertel   58: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   59:          $id   - a bighash Id number
1.71      albertel   60:          $def  - the resource's default value   'stupid emacs
                     61: 
1.556     raeburn    62: Returns:  A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71      albertel   63: 
1.556     raeburn    64: 18 - General Course
                     65: 17 - Map or Folder level in course (recursive) 
                     66: 16 - Map or Folder level in course (non-recursive)
                     67: 15 - resource default
                     68: 14 - map default
                     69: 13 - resource level in course
                     70: 12 - General for section
                     71: 11 - Map or Folder level for section (recursive)
                     72: 10 - Map or Folder level for section (non-recursive)
                     73: 9 - resource level in section
                     74: 8 - General for group
                     75: 7 - Map or Folder level for group (recursive)
                     76: 6 - Map or Folder level for group (non-recursive)
                     77: 5 - resource level in group
                     78: 4 - General for specific student
                     79: 3 - Map or Folder level for specific student (recursive)
                     80: 2 - Map or Folder level for specific student (non-recursive)
1.71      albertel   81: 1 - resource level for specific student
1.2       www        82: 
1.416     jms        83: =item parmval_by_symb()
                     84: 
                     85: =item reset_caches()
                     86: 
                     87: =item cacheparmhash() 
                     88: 
                     89: =item parmhash()
                     90: 
                     91: =item symbcache()
                     92: 
                     93: =item preset_defaults()
                     94: 
                     95: =item date_sanity_info()
                     96: 
                     97: =item storeparm()
                     98: 
                     99: Store a parameter by symb
                    100: 
                    101:     Takes
                    102:     - symb
                    103:     - name of parameter
                    104:     - level
                    105:     - new value
                    106:     - new type
                    107:     - username
                    108:     - userdomain
                    109: 
                    110: =item log_parmset()
                    111: 
                    112: =item storeparm_by_symb_inner()
                    113: 
                    114: =item valout()
                    115: 
                    116: Format a value for output.
                    117: 
                    118: Inputs:  $value, $type, $editable
                    119: 
                    120: Returns: $value, formatted for output.  If $type indicates it is a date,
                    121: localtime($value) is returned.
                    122: $editable will return an icon to click on
                    123: 
                    124: =item plink()
                    125: 
                    126: Produces a link anchor.
                    127: 
                    128: Inputs: $type,$dis,$value,$marker,$return,$call
                    129: 
                    130: Returns: scalar with html code for a link which will envoke the 
                    131: javascript function 'pjump'.
                    132: 
                    133: =item page_js()
                    134: 
                    135: =item startpage()
                    136: 
                    137: =item print_row()
                    138: 
                    139: =item print_td()
                    140: 
1.580     raeburn   141: =item check_other_groups()
1.416     jms       142: 
                    143: =item parm_control_group()
                    144: 
                    145: =item extractResourceInformation() : 
                    146: 
1.512     foxr      147:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       148: 
1.542     raeburn   149: Input: See list below
                    150: 
                    151: =over 4
1.416     jms       152: 
1.512     foxr      153: =item * B<env{'user.name'}> : Current username
1.416     jms       154: 
1.512     foxr      155: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       156: 
1.542     raeburn   157: =item * B<env{"request.course.fn"}> : Course
                    158: 
                    159: =back
1.416     jms       160: 
1.512     foxr      161: Outputs: See list below:
1.416     jms       162: 
1.542     raeburn   163: =over 4
                    164: 
1.512     foxr      165: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       166: 
1.512     foxr      167: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416     jms       168: 
1.512     foxr      169: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416     jms       170: 
1.512     foxr      171: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       172: 
1.512     foxr      173: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    174: 
                    175: =item * B<allmaps> (out) : hash, ???
1.416     jms       176: 
                    177: =item * B<mapp> : ??
                    178: 
                    179: =item * B<symbp> : hash, id->full sym?
                    180: 
1.512     foxr      181: =item * B<maptitles>
                    182: 
                    183: =item * B<uris>
1.416     jms       184: 
1.512     foxr      185: =item * B<keyorder>
                    186: 
                    187: =item * B<defkeytype>
1.416     jms       188: 
1.542     raeburn   189: =back
                    190: 
1.416     jms       191: =item isdateparm()
                    192: 
                    193: =item parmmenu()
                    194: 
                    195: =item partmenu()
                    196: 
                    197: =item usermenu()
                    198: 
                    199: =item displaymenu()
                    200: 
                    201: =item mapmenu()
                    202: 
                    203: =item levelmenu()
                    204: 
                    205: =item sectionmenu()
                    206: 
                    207: =item keysplit()
                    208: 
                    209: =item keysinorder()
                    210: 
                    211: =item keysinorder_bytype()
                    212: 
                    213: =item keysindisplayorder()
                    214: 
                    215: =item standardkeyorder()
                    216: 
                    217: =item assessparms() : 
                    218: 
                    219: Show assessment data and parameters.  This is a large routine that should
                    220: be simplified and shortened... someday.
                    221: 
1.513     foxr      222: Inputs: $r - the Apache request object.
                    223:   
1.416     jms       224: Returns: nothing
                    225: 
                    226: Variables used (guessed by Jeremy):
                    227: 
1.542     raeburn   228: =over
                    229: 
1.416     jms       230: =item * B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
                    231: 
                    232: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    233: 
                    234: =item * B<@catmarker> contains list of all possible parameters including part #s
                    235: 
                    236: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    237: 
                    238: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    239:         When storing information, store as part 0
                    240:         When requesting information, request from full part
                    241: 
1.542     raeburn   242: =back
                    243: 
1.416     jms       244: =item tablestart()
                    245: 
                    246: =item tableend()
                    247: 
                    248: =item extractuser()
                    249: 
                    250: =item parse_listdata_key()
                    251: 
                    252: =item listdata()
                    253: 
                    254: =item date_interval_selector()
                    255: 
                    256: =item get_date_interval_from_form()
                    257: 
                    258: =item default_selector()
                    259: 
                    260: =item string_selector()
                    261: 
                    262: =item dateshift()
                    263: 
                    264: =item newoverview()
                    265: 
                    266: =item secgroup_lister()
                    267: 
                    268: =item overview()
                    269: 
                    270: =item clean_parameters()
                    271: 
                    272: =item date_shift_one()
                    273: 
                    274: =item date_shift_two()
                    275: 
                    276: =item parse_key()
                    277: 
                    278: =item header()
                    279: 
                    280: Output html header for page
                    281: 
                    282: =item print_main_menu()
                    283: 
                    284: =item output_row()
                    285: 
                    286: Set portfolio metadata
                    287: 
                    288: =item order_meta_fields()
                    289: 
                    290: =item addmetafield()
                    291: 
                    292: =item setrestrictmeta()
                    293: 
                    294: =item get_added_meta_fieldnames()
                    295: 
                    296: =item get_deleted_meta_fieldnames()
                    297: 
                    298: =item defaultsetter()
                    299: 
                    300: =item components()
                    301: 
                    302: =item load_parameter_names()
                    303: 
                    304: =item parm_change_log()
                    305: 
                    306: =item handler() : 
                    307: 
1.450     raeburn   308: Main handler.  Calls &assessparms subroutine.
1.416     jms       309: 
                    310: =back
                    311: 
1.59      matthew   312: =cut
                    313: 
1.416     jms       314: ###################################################################
                    315: ###################################################################
                    316: 
                    317: package Apache::lonparmset;
                    318: 
                    319: use strict;
                    320: use Apache::lonnet;
                    321: use Apache::Constants qw(:common :http REDIRECT);
                    322: use Apache::lonhtmlcommon();
                    323: use Apache::loncommon;
                    324: use GDBM_File;
                    325: use Apache::lonhomework;
                    326: use Apache::lonxml;
                    327: use Apache::lonlocal;
                    328: use Apache::lonnavmaps;
                    329: use Apache::longroup;
                    330: use Apache::lonrss;
1.506     www       331: use HTML::Entities;
1.416     jms       332: use LONCAPA qw(:DEFAULT :match);
                    333: 
                    334: 
1.560     damieng   335: ##################################################
                    336: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
                    337: ##################################################
                    338: 
                    339: # Page header
1.561     damieng   340: #
                    341: # @param {Apache2::RequestRec} $r - Apache request object
                    342: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
                    343: # @param {string} $crstype - course type ('Community' for community settings)
1.507     www       344: sub startSettingsScreen {
1.531     raeburn   345:     my ($r,$mode,$crstype)=@_;
1.507     www       346: 
1.531     raeburn   347:     my $tabtext = &mt('Course Settings');
                    348:     if ($crstype eq 'Community') {
                    349:         $tabtext = &mt('Community Settings');
                    350:     } 
1.507     www       351:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
                    352:     $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.531     raeburn   353:                                           $tabtext.
1.507     www       354:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    355: 
1.523     raeburn   356:     $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507     www       357:                                                                  &mt('Content and Problem Settings').'</b></a></li>');
                    358:     $r->print("\n".'</ul>'."\n");
1.523     raeburn   359:     $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507     www       360: }
                    361: 
1.560     damieng   362: # Page footer
1.507     www       363: sub endSettingsScreen {
                    364:    my ($r)=@_;
                    365:    $r->print('</div></div></div>');
                    366: }
                    367: 
                    368: 
                    369: 
1.560     damieng   370: ##################################################
1.563     damieng   371: # (mostly) TABLE MODE
1.560     damieng   372: # (parmval is also used for the log of parameter changes)
                    373: ##################################################
                    374: 
1.566     damieng   375: # Calls parmval_by_symb, getting the symb from $id with &symbcache.
1.561     damieng   376: #
                    377: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   378: # @param {string} $id - resource id or map pc
1.561     damieng   379: # @param {string} $def - the resource's default value for this parameter
                    380: # @param {string} $uname - user name
                    381: # @param {string} $udom - user domain
                    382: # @param {string} $csec - section name
                    383: # @param {string} $cgroup - group name
                    384: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    385: # @returns {Array}
1.2       www       386: sub parmval {
1.275     raeburn   387:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    388:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    389:                                                            $cgroup,$courseopt);
1.201     www       390: }
                    391: 
1.561     damieng   392: # Returns an array containing
                    393: # - the most specific level that is defined for that parameter (integer)
                    394: # - an array with the level as index and the parameter value as value (when defined)
                    395: #   (level 1 is the most specific and will have precedence)
                    396: #
                    397: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   398: # @param {string} $symb - resource symb or map src
1.561     damieng   399: # @param {string} $def - the resource's default value for this parameter
                    400: # @param {string} $uname - user name
                    401: # @param {string} $udom - user domain
                    402: # @param {string} $csec - section name
                    403: # @param {string} $cgroup - group name
                    404: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    405: # @returns {Array}
1.201     www       406: sub parmval_by_symb {
1.275     raeburn   407:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       408: 
1.352     albertel  409:     my $useropt;
                    410:     if ($uname ne '' && $udom ne '') {
1.561     damieng   411:         $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  412:     }
1.200     www       413: 
1.8       www       414:     my $result='';
1.44      albertel  415:     my @outpar=();
1.2       www       416: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    417:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  418:     $map = &Apache::lonnet::deversion($map);
1.561     damieng   419:     
                    420:     # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
                    421:     # any change should be reflected there.
                    422:     
1.201     www       423:     my $symbparm=$symb.'.'.$what;
1.556     raeburn   424:     my $recurseparm=$map.'___(rec).'.$what; 
1.201     www       425:     my $mapparm=$map.'___(all).'.$what;
1.10      www       426: 
1.269     raeburn   427:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    428:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   429:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   430:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    431: 
1.190     albertel  432:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    433:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   434:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  435:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    436: 
                    437:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    438:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   439:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  440:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       441: 
1.11      www       442: 
1.182     albertel  443: # --------------------------------------------------------- first, check course
1.11      www       444: 
1.561     damieng   445: # 18 - General Course
1.200     www       446:     if (defined($$courseopt{$courselevel})) {
1.556     raeburn   447:         $outpar[18]=$$courseopt{$courselevel};
                    448:         $result=18;
                    449:     }
                    450: 
1.561     damieng   451: # 17 - Map or Folder level in course (recursive) 
1.556     raeburn   452:     if (defined($$courseopt{$courseleveli})) {
                    453:         $outpar[17]=$$courseopt{$courseleveli};
                    454:         $result=17;
1.43      albertel  455:     }
1.11      www       456: 
1.561     damieng   457: # 16 - Map or Folder level in course (non-recursive)
1.200     www       458:     if (defined($$courseopt{$courselevelm})) {
1.556     raeburn   459:         $outpar[16]=$$courseopt{$courselevelm};
                    460:         $result=16;
1.43      albertel  461:     }
1.11      www       462: 
1.182     albertel  463: # ------------------------------------------------------- second, check default
                    464: 
1.561     damieng   465: # 15 - resource default
1.556     raeburn   466:     if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182     albertel  467: 
                    468: # ------------------------------------------------------ third, check map parms
                    469: 
1.556     raeburn   470:     
1.561     damieng   471: # 14 - map default
1.376     albertel  472:     my $thisparm=&parmhash($symbparm);
1.556     raeburn   473:     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182     albertel  474: 
1.561     damieng   475: # 13 - resource level in course
1.200     www       476:     if (defined($$courseopt{$courselevelr})) {
1.556     raeburn   477:         $outpar[13]=$$courseopt{$courselevelr};
                    478:         $result=13;
1.43      albertel  479:     }
1.11      www       480: 
1.182     albertel  481: # ------------------------------------------------------ fourth, back to course
1.352     albertel  482:     if ($csec ne '') {
1.561     damieng   483: # 12 - General for section
1.200     www       484:         if (defined($$courseopt{$seclevel})) {
1.556     raeburn   485:             $outpar[12]=$$courseopt{$seclevel};
                    486:             $result=12;
                    487:         }
1.561     damieng   488: # 11 - Map or Folder level for section (recursive)
1.556     raeburn   489:         if (defined($$courseopt{$secleveli})) {
                    490:             $outpar[11]=$$courseopt{$secleveli};
                    491:             $result=11;
                    492:         }
1.561     damieng   493: # 10 - Map or Folder level for section (non-recursive)
1.200     www       494:         if (defined($$courseopt{$seclevelm})) {
1.556     raeburn   495:             $outpar[10]=$$courseopt{$seclevelm};
                    496:             $result=10;
                    497:         }
1.561     damieng   498: # 9 - resource level in section
1.200     www       499:         if (defined($$courseopt{$seclevelr})) {
1.556     raeburn   500:             $outpar[9]=$$courseopt{$seclevelr};
                    501:             $result=9;
                    502:         }
1.43      albertel  503:     }
1.275     raeburn   504: # ------------------------------------------------------ fifth, check course group
1.352     albertel  505:     if ($cgroup ne '') {
1.561     damieng   506: # 8 - General for group
1.269     raeburn   507:         if (defined($$courseopt{$grplevel})) {
1.556     raeburn   508:             $outpar[8]=$$courseopt{$grplevel};
                    509:             $result=8;
                    510:         }
1.561     damieng   511: # 7 - Map or Folder level for group (recursive)
1.556     raeburn   512:         if (defined($$courseopt{$grpleveli})) {
                    513:             $outpar[7]=$$courseopt{$grpleveli};
                    514:             $result=7;
1.269     raeburn   515:         }
1.561     damieng   516: # 6 - Map or Folder level for group (non-recursive)
1.269     raeburn   517:         if (defined($$courseopt{$grplevelm})) {
1.556     raeburn   518:             $outpar[6]=$$courseopt{$grplevelm};
                    519:             $result=6;
1.269     raeburn   520:         }
1.561     damieng   521: # 5 - resource level in group
1.269     raeburn   522:         if (defined($$courseopt{$grplevelr})) {
1.556     raeburn   523:             $outpar[5]=$$courseopt{$grplevelr};
                    524:             $result=5;
1.269     raeburn   525:         }
                    526:     }
1.11      www       527: 
1.556     raeburn   528: # ---------------------------------------------------------- sixth, check user
1.11      www       529: 
1.352     albertel  530:     if ($uname ne '') {
1.561     damieng   531: # 4 - General for specific student
                    532:         if (defined($$useropt{$courselevel})) {
                    533:             $outpar[4]=$$useropt{$courselevel};
                    534:             $result=4;
                    535:         }
1.556     raeburn   536: 
1.561     damieng   537: # 3 - Map or Folder level for specific student (recursive)
                    538:         if (defined($$useropt{$courseleveli})) {
                    539:             $outpar[3]=$$useropt{$courseleveli};
                    540:             $result=3;
                    541:         }
1.473     amueller  542: 
1.561     damieng   543: # 2 - Map or Folder level for specific student (non-recursive)
                    544:         if (defined($$useropt{$courselevelm})) {
                    545:             $outpar[2]=$$useropt{$courselevelm};
                    546:             $result=2;
                    547:         }
1.473     amueller  548: 
1.561     damieng   549: # 1 - resource level for specific student
                    550:         if (defined($$useropt{$courselevelr})) {
                    551:             $outpar[1]=$$useropt{$courselevelr};
                    552:             $result=1;
                    553:         }
1.43      albertel  554:     }
1.44      albertel  555:     return ($result,@outpar);
1.2       www       556: }
                    557: 
1.198     www       558: 
                    559: 
1.376     albertel  560: # --- Caches local to lonparmset
                    561: 
1.446     bisitz    562: 
1.561     damieng   563: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376     albertel  564: sub reset_caches {
                    565:     &resetparmhash();
                    566:     &resetsymbcache();
                    567:     &resetrulescache();
1.203     www       568: }
                    569: 
1.561     damieng   570: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
                    571: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376     albertel  572: {
1.561     damieng   573:     my $parmhashid; # course identifier, to initialize the cache only once for a course
                    574:     my %parmhash; # the parameter cache
                    575:     # reset map parameter hash
1.376     albertel  576:     sub resetparmhash {
1.560     damieng   577:         undef($parmhashid);
                    578:         undef(%parmhash);
1.376     albertel  579:     }
1.446     bisitz    580: 
1.561     damieng   581:     # dump the _parms.db database into %parmhash
1.376     albertel  582:     sub cacheparmhash {
1.560     damieng   583:         if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    584:         my %parmhashfile;
                    585:         if (tie(%parmhashfile,'GDBM_File',
                    586:             $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    587:             %parmhash=%parmhashfile;
                    588:             untie(%parmhashfile);
                    589:             $parmhashid=$env{'request.course.fn'};
                    590:         }
1.201     www       591:     }
1.446     bisitz    592: 
1.561     damieng   593:     # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376     albertel  594:     sub parmhash {
1.560     damieng   595:         my ($id) = @_;
                    596:         &cacheparmhash();
                    597:         return $parmhash{$id};
1.376     albertel  598:     }
1.560     damieng   599: }
1.376     albertel  600: 
1.566     damieng   601: # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
1.446     bisitz    602: {
1.561     damieng   603:     my $symbsid; # course identifier, to initialize the cache only once for a course
                    604:     my %symbs; # hash id->symb
                    605:     # reset the id->symb cache
1.376     albertel  606:     sub resetsymbcache {
1.560     damieng   607:         undef($symbsid);
                    608:         undef(%symbs);
1.376     albertel  609:     }
1.446     bisitz    610: 
1.566     damieng   611:     # returns the resource symb or map src corresponding to a resource id or map pc
                    612:     # (using lonnavmaps and a cache)
1.376     albertel  613:     sub symbcache {
1.560     damieng   614:         my $id=shift;
                    615:         if ($symbsid ne $env{'request.course.id'}) {
                    616:             undef(%symbs);
                    617:         }
                    618:         if (!$symbs{$id}) {
                    619:             my $navmap = Apache::lonnavmaps::navmap->new();
                    620:             if ($id=~/\./) {
                    621:                 my $resource=$navmap->getById($id);
                    622:                 $symbs{$id}=$resource->symb();
                    623:             } else {
                    624:                 my $resource=$navmap->getByMapPc($id);
                    625:                 $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    626:             }
                    627:             $symbsid=$env{'request.course.id'};
1.473     amueller  628:         }
1.560     damieng   629:         return $symbs{$id};
1.473     amueller  630:     }
1.560     damieng   631: }
1.201     www       632: 
1.561     damieng   633: # cache for parameter default actions (stored in parmdefactions.db)
1.446     bisitz    634: {
1.561     damieng   635:     my $rulesid; # course identifier, to initialize the cache only once for a course
                    636:     my %rules; # parameter default actions hash
1.376     albertel  637:     sub resetrulescache {
1.560     damieng   638:         undef($rulesid);
                    639:         undef(%rules);
1.376     albertel  640:     }
1.446     bisitz    641: 
1.561     damieng   642:     # returns the value for a given key in the parameter default action hash
1.376     albertel  643:     sub rulescache {
1.560     damieng   644:         my $id=shift;
                    645:         if ($rulesid ne $env{'request.course.id'}
                    646:             && !defined($rules{$id})) {
                    647:             my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    648:             my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    649:             %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    650:             $rulesid=$env{'request.course.id'};
                    651:         }
                    652:         return $rules{$id};
1.221     www       653:     }
                    654: }
                    655: 
1.416     jms       656: 
1.561     damieng   657: # Returns the values of the parameter type default action
                    658: # "default value when manually setting".
                    659: # If none is defined, ('','','','','') is returned.
                    660: #
                    661: # @param {string} $type - parameter type
                    662: # @returns {Array<string>} - (hours, min, sec, value)
1.229     www       663: sub preset_defaults {
                    664:     my $type=shift;
                    665:     if (&rulescache($type.'_action') eq 'default') {
1.560     damieng   666:         # yes, there is something
                    667:         return (&rulescache($type.'_hours'),
                    668:             &rulescache($type.'_min'),
                    669:             &rulescache($type.'_sec'),
                    670:             &rulescache($type.'_value'));
1.229     www       671:     } else {
1.560     damieng   672:         # nothing there or something else
                    673:         return ('','','','','');
1.229     www       674:     }
                    675: }
                    676: 
1.416     jms       677: 
1.561     damieng   678: # Checks that a date is after enrollment start date and before
                    679: # enrollment end date.
                    680: # Returns HTML with a warning if it is not, or the empty string otherwise.
                    681: # This is used by both overview and table modes.
                    682: #
                    683: # @param {integer} $checkdate - the date to check.
                    684: # @returns {string} - HTML possibly containing a localized warning message.
1.277     www       685: sub date_sanity_info {
                    686:    my $checkdate=shift;
                    687:    unless ($checkdate) { return ''; }
                    688:    my $result='';
                    689:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    690:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    691:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    692:          $result.='<div class="LC_warning">'
                    693:                  .&mt('After course enrollment end!')
                    694:                  .'</div>';
1.277     www       695:       }
                    696:    }
                    697:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    698:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    699:          $result.='<div class="LC_warning">'
                    700:                  .&mt('Before course enrollment start!')
                    701:                  .'</div>';
1.277     www       702:       }
                    703:    }
1.413     bisitz    704: # Preparation for additional warnings about dates in the past/future.
                    705: # An improved, more context sensitive version is recommended,
                    706: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    707: #   if ($checkdate<time) {
                    708: #      $result.='<div class="LC_info">'
                    709: #              .'('.&mt('in the past').')'
                    710: #              .'</div>';
                    711: #      }
                    712: #   if ($checkdate>time) {
                    713: #      $result.='<div class="LC_info">'
                    714: #              .'('.&mt('in the future').')'
                    715: #              .'</div>';
                    716: #      }
1.277     www       717:    return $result;
                    718: }
1.561     damieng   719: 
                    720: 
                    721: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186     www       722: #
1.566     damieng   723: # @param {string} $sresid - resource id or map pc
1.565     damieng   724: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   725: # @param {integer} $snum - level
                    726: # @param {string} $nval - new value
                    727: # @param {string} $ntype - new type
                    728: # @param {string} $uname - username
                    729: # @param {string} $udom - userdomain
                    730: # @param {string} $csec - section name
                    731: # @param {string} $cgroup - group name
1.186     www       732: sub storeparm {
1.269     raeburn   733:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   734:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       735: }
                    736: 
1.561     damieng   737: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
                    738: 
                    739: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
                    740: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
                    741: #
1.566     damieng   742: # @param {string} $symb - resource symb or map src
1.565     damieng   743: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   744: # @param {integer} $snum - level
                    745: # @param {string} $nval - new value
                    746: # @param {string} $ntype - new type
                    747: # @param {string} $uname - username
                    748: # @param {string} $udom - userdomain
                    749: # @param {string} $csec - section name
                    750: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
                    751: # @param {string} $cgroup - group name
1.197     www       752: sub storeparm_by_symb {
1.275     raeburn   753:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       754:     unless ($recflag) {
1.560     damieng   755:         # first time call
                    756:         %recstack=();
                    757:         $recflag=1;
1.226     www       758:     }
1.560     damieng   759:     # store parameter
1.226     www       760:     &storeparm_by_symb_inner
1.473     amueller  761:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560     damieng   762:     # don't do anything if parameter was reset
1.266     www       763:     unless ($nval) { return; }
1.226     www       764:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560     damieng   765:     # remember that this was set
1.226     www       766:     $recstack{$parm}=1;
1.560     damieng   767:     # what does this trigger?
1.226     www       768:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560     damieng   769:         # don't backfire
                    770:         unless ((!$triggered) || ($recstack{$triggered})) {
                    771:             my $action=&rulescache($triggered.'_action');
                    772:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    773:             # set triggered parameter on same level
                    774:             my $newspnam=$prefix.$triggered;
                    775:             my $newvalue='';
                    776:             my $active=1;
                    777:             if ($action=~/^when\_setting/) {
                    778:             # are there restrictions?
                    779:                 if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    780:                     $active=0;
1.565     damieng   781:                     foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560     damieng   782:                         if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    783:                     }
                    784:                 }
                    785:                 $newvalue=&rulescache($triggered.'_value');
                    786:             } else {
                    787:                 my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    788:                 if ($action=~/^later\_than/) {
                    789:                     $newvalue=$nval+$totalsecs;
                    790:                 } else {
                    791:                     $newvalue=$nval-$totalsecs;
                    792:                 }
                    793:             }
                    794:             if ($active) {
                    795:                 &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    796:                         $uname,$udom,$csec,$recflag,$cgroup);
                    797:             }
                    798:         }
1.226     www       799:     }
                    800:     return '';
                    801: }
                    802: 
1.561     damieng   803: # Adds all given arguments to the course parameter log.
                    804: # @returns {string} - the answer to the lonnet query.
1.293     www       805: sub log_parmset {
1.525     raeburn   806:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       807: }
                    808: 
1.561     damieng   809: # Store a parameter value and type by symb, without using the parameter default actions.
                    810: # Expire related sheets.
                    811: #
1.566     damieng   812: # @param {string} $symb - resource symb or map src
1.561     damieng   813: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
                    814: # @param {integer} $snum - level
                    815: # @param {string} $nval - new value
                    816: # @param {string} $ntype - new type
                    817: # @param {string} $uname - username
                    818: # @param {string} $udom - userdomain
                    819: # @param {string} $csec - section name
                    820: # @param {string} $cgroup - group name
                    821: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226     www       822: sub storeparm_by_symb_inner {
1.197     www       823: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   824:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       825: # ---------------------------------------------------------- Construct prefixes
1.186     www       826:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    827:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  828:     $map = &Apache::lonnet::deversion($map);
                    829: 
1.197     www       830:     my $symbparm=$symb.'.'.$spnam;
1.556     raeburn   831:     my $recurseparm=$map.'___(rec).'.$spnam;
1.197     www       832:     my $mapparm=$map.'___(all).'.$spnam;
                    833: 
1.269     raeburn   834:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    835:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   836:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   837:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    838: 
1.190     albertel  839:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    840:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   841:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  842:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    843: 
1.190     albertel  844:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    845:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   846:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  847:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    848: 
1.186     www       849:     my $storeunder='';
1.578     raeburn   850:     my $possreplace='';
1.556     raeburn   851:     if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
1.578     raeburn   852:     if (($snum==17) || ($snum==3)) { 
                    853:         $storeunder=$courseleveli;
                    854:         $possreplace=$courselevelm; 
                    855:     } 
                    856:     if (($snum==16) || ($snum==2)) { 
                    857:         $storeunder=$courselevelm;
                    858:         $possreplace=$courseleveli;
                    859:     }
1.556     raeburn   860:     if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
                    861:     if ($snum==12) { $storeunder=$seclevel; }
1.578     raeburn   862:     if ($snum==11) { 
                    863:         $storeunder=$secleveli;
                    864:         $possreplace=$seclevelm; 
                    865:     }
                    866:     if ($snum==10) { 
                    867:         $storeunder=$seclevelm;
                    868:         $possreplace=$secleveli;
                    869:     }
1.556     raeburn   870:     if ($snum==9) { $storeunder=$seclevelr; }
                    871:     if ($snum==8) { $storeunder=$grplevel; }
1.578     raeburn   872:     if ($snum==7) { 
                    873:         $storeunder=$grpleveli;
                    874:         $possreplace=$grplevelm;
                    875:     }
                    876:     if ($snum==6) {
                    877:         $storeunder=$grplevelm;
                    878:         $possreplace=$grpleveli;
                    879:     }
1.556     raeburn   880:     if ($snum==5) { $storeunder=$grplevelr; }
1.269     raeburn   881: 
1.446     bisitz    882: 
1.186     www       883:     my $delete;
                    884:     if ($nval eq '') { $delete=1;}
                    885:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  886:             $storeunder.'.type' => $ntype);
1.186     www       887:     my $reply='';
1.560     damieng   888:     
1.556     raeburn   889:     if ($snum>4) {
1.186     www       890: # ---------------------------------------------------------------- Store Course
                    891: #
1.560     damieng   892:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    893:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    894:         # Expire sheets
                    895:         &Apache::lonnet::expirespread('','','studentcalc');
                    896:         if (($snum==13) || ($snum==9) || ($snum==5)) {
                    897:             &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.578     raeburn   898:         } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
1.560     damieng   899:             &Apache::lonnet::expirespread('','','assesscalc',$map);
                    900:         } else {
                    901:             &Apache::lonnet::expirespread('','','assesscalc');
                    902:         }
                    903:         # Store parameter
                    904:         if ($delete) {
                    905:             $reply=&Apache::lonnet::del
                    906:             ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
                    907:                 &log_parmset(\%storecontent,1);
                    908:         } else {
                    909:             $reply=&Apache::lonnet::cput
                    910:             ('resourcedata',\%storecontent,$cdom,$cnum);
                    911:             &log_parmset(\%storecontent);
1.578     raeburn   912:             if ($possreplace) {
                    913:                 my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
                    914:                 if (ref($resdata) eq 'HASH') {
                    915:                     if (exists($resdata->{$possreplace})) {
                    916:                         if (&Apache::lonnet::del
                    917:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
                    918:                             &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);   
                    919:                         }
                    920:                     }
                    921:                 }
                    922:             }
1.560     damieng   923:         }
                    924:         &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       925:     } else {
                    926: # ------------------------------------------------------------------ Store User
                    927: #
1.560     damieng   928:         # Expire sheets
                    929:         &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    930:         if ($snum==1) {
                    931:             &Apache::lonnet::expirespread
                    932:             ($uname,$udom,'assesscalc',$symb);
1.578     raeburn   933:         } elsif (($snum==2) || ($snum==3)) {
1.560     damieng   934:             &Apache::lonnet::expirespread
                    935:             ($uname,$udom,'assesscalc',$map);
                    936:         } else {
                    937:             &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    938:         }
                    939:         # Store parameter
                    940:         if ($delete) {
                    941:             $reply=&Apache::lonnet::del
                    942:             ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    943:             &log_parmset(\%storecontent,1,$uname,$udom);
                    944:         } else {
                    945:             $reply=&Apache::lonnet::cput
                    946:             ('resourcedata',\%storecontent,$udom,$uname);
                    947:             &log_parmset(\%storecontent,0,$uname,$udom);
1.578     raeburn   948:             if ($possreplace) {
                    949:                 my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
                    950:                 if (ref($resdata) eq 'HASH') {
                    951:                     if (exists($resdata->{$possreplace})) {
                    952:                         if (&Apache::lonnet::del
                    953:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
                    954:                             &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
                    955:                                           $uname,$udom);
                    956:                         }
                    957:                     }
                    958:                 }
                    959:             }
1.560     damieng   960:         }
                    961:         &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       962:     }
1.446     bisitz    963: 
1.186     www       964:     if ($reply=~/^error\:(.*)/) {
1.560     damieng   965:         return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       966:     }
                    967:     return '';
                    968: }
                    969: 
1.9       www       970: 
1.561     damieng   971: # Returns HTML with the value of the given parameter,
                    972: # using a readable format for dates, and
                    973: # a warning if there is a problem with a date.
                    974: # Used by table mode.
                    975: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
                    976: #
                    977: # @param {string} $value - the parameter value
                    978: # @param {string} $type - the parameter type
                    979: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9       www       980: sub valout {
1.554     raeburn   981:     my ($value,$type,$name,$editable)=@_;
1.59      matthew   982:     my $result = '';
                    983:     # Values of zero are valid.
                    984:     if (! $value && $value ne '0') {
1.528     bisitz    985:         if ($editable) {
                    986:             $result =
                    987:                 '<img src="/res/adm/pages/editmap.png"'
                    988:                .' alt="'.&mt('Change').'"'
1.539     raeburn   989:                .' title="'.&mt('Change').'" style="border:0;" />';
1.528     bisitz    990:         } else {
                    991:             $result='&nbsp;';
                    992:         }
1.59      matthew   993:     } else {
1.66      www       994:         if ($type eq 'date_interval') {
1.559     raeburn   995:             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    996:             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    997:             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    998:                 $donebuttontext = $1;
                    999:                 (undef,$proctor,$secretkey) = split(/_/,$2);
                   1000:                 $usesdone = 'done';
                   1001:             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                   1002:                 $donebuttontext = &mt('Done');
                   1003:                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                   1004:             }
1.554     raeburn  1005:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz   1006:             my @timer;
1.66      www      1007:             $year=$year-70;
                   1008:             $mday--;
                   1009:             if ($year) {
1.413     bisitz   1010: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                   1011:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www      1012:             }
                   1013:             if ($mon) {
1.413     bisitz   1014: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                   1015:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www      1016:             }
                   1017:             if ($mday) {
1.413     bisitz   1018: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                   1019:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www      1020:             }
                   1021:             if ($hour) {
1.413     bisitz   1022: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                   1023:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www      1024:             }
                   1025:             if ($min) {
1.413     bisitz   1026: #               $result.=&mt('[quant,_1,min]',$min).' ';
                   1027:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www      1028:             }
                   1029:             if ($sec) {
1.413     bisitz   1030: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                   1031:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www      1032:             }
1.413     bisitz   1033: #           $result=~s/\s+$//;
                   1034:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                   1035:                 push(@timer,&mt('[quant,_1,sec]',0));
                   1036:             }
                   1037:             $result.=join(", ",@timer);
1.559     raeburn  1038:             if ($usesdone eq 'done') {
1.558     raeburn  1039:                 if ($secretkey) {
1.559     raeburn  1040:                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);  
1.558     raeburn  1041:                 } else {
1.559     raeburn  1042:                     $result .= ' + "'.$donebuttontext.'"';
                   1043:                 }
1.554     raeburn  1044:             }
1.213     www      1045:         } elsif (&isdateparm($type)) {
1.361     albertel 1046:             $result = &Apache::lonlocal::locallocaltime($value).
1.560     damieng  1047:                 &date_sanity_info($value);
1.59      matthew  1048:         } else {
                   1049:             $result = $value;
1.517     www      1050:             $result=~s/\,/\, /gs;
1.560     damieng  1051:             $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew  1052:         }
                   1053:     }
                   1054:     return $result;
1.9       www      1055: }
                   1056: 
1.59      matthew  1057: 
1.561     damieng  1058: # Returns HTML containing a link on a parameter value, for table mode.
                   1059: # The link uses the javascript function 'pjump'.
                   1060: #
                   1061: # @param {string} $type - parameter type
                   1062: # @param {string} $dis - dialog title for editing the parameter value and type
                   1063: # @param {string} $value - parameter value
                   1064: # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
                   1065: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
                   1066: # @param {string} $call - javascript function to call to submit the form ('psub')
1.588     raeburn  1067: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
                   1068: # @param {string} $extra - optional additional information to send as tenth arg in call to javascript pjump function.
1.5       www      1069: sub plink {
1.588     raeburn  1070:     my ($type,$dis,$value,$marker,$return,$call,$recursive,$extra)=@_;
1.23      www      1071:     my $winvalue=$value;
                   1072:     unless ($winvalue) {
1.592     raeburn  1073:         if (&isdateparm($type) || (&is_specialstring($type))) {
1.190     albertel 1074:             $winvalue=$env{'form.recent_'.$type};
1.591     raeburn  1075:         } elsif ($type eq 'string_yesno') {
                   1076:             if ($env{'form.recent_string'} =~ /^(yes|no)$/i) {
                   1077:                 $winvalue=$env{'form.recent_string'};
                   1078:             }
1.23      www      1079:         } else {
1.190     albertel 1080:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1081:         }
                   1082:     }
1.229     www      1083:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1084:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1085:     unless (defined($winvalue)) { $winvalue=$val; }
1.593   ! raeburn  1086:     my $valout = &valout($value,$type,1);
1.429     raeburn  1087:     my $unencmarker = $marker;
1.378     albertel 1088:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.588     raeburn  1089:               \$hour, \$min, \$sec, \$extra) {
1.560     damieng  1090:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1091:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1092:     }
1.429     raeburn  1093:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1094:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.588     raeburn  1095:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."','".$extra."'".');">'.
1.578     raeburn  1096:         $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
                   1097:                                               &mt('recursive').'</td></tr>' : '').'</table>';
                   1098: 
1.5       www      1099: }
                   1100: 
1.561     damieng  1101: # Javascript for table mode.
1.280     albertel 1102: sub page_js {
                   1103: 
1.81      www      1104:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1105:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1106: 
                   1107:     return(<<ENDJS);
                   1108: <script type="text/javascript">
1.454     bisitz   1109: // <![CDATA[
1.44      albertel 1110: 
1.88      matthew  1111:     $pjump_def
1.44      albertel 1112: 
                   1113:     function psub() {
1.591     raeburn  1114:         var specstring = /^string_!(yesno|any)/i;
1.44      albertel 1115:         if (document.parmform.pres_marker.value!='') {
                   1116:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1117:             var typedef=new Array();
                   1118:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1119:             if (document.parmform.pres_type.value!='') {
1.589     raeburn  1120:                 if ((typedef[0]=='date') || 
1.591     raeburn  1121:                     (specstring.test(document.parmform.pres_type.value)))  {
1.562     damieng  1122:                     eval('document.parmform.recent_'+
                   1123:                         document.parmform.pres_type.value+
                   1124:                         '.value=document.parmform.pres_value.value;');
                   1125:                 } else {
                   1126:                     eval('document.parmform.recent_'+typedef[0]+
                   1127:                         '.value=document.parmform.pres_value.value;');
                   1128:                 }
1.44      albertel 1129:             }
                   1130:             document.parmform.submit();
                   1131:         } else {
                   1132:             document.parmform.pres_value.value='';
                   1133:             document.parmform.pres_marker.value='';
                   1134:         }
                   1135:     }
                   1136: 
1.57      albertel 1137:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1138:         var options = "width=" + w + ",height=" + h + ",";
                   1139:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1140:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1141:         var newWin = window.open(url, wdwName, options);
                   1142:         newWin.focus();
                   1143:     }
1.523     raeburn  1144: 
1.454     bisitz   1145: // ]]>
1.523     raeburn  1146: 
1.44      albertel 1147: </script>
1.81      www      1148: $selscript
1.280     albertel 1149: ENDJS
                   1150: 
                   1151: }
1.507     www      1152: 
1.561     damieng  1153: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1154: # for table and overview modes.
1.523     raeburn  1155: sub showhide_js {
                   1156:     return <<"COURSECONTENTSCRIPT";
                   1157: 
                   1158: function showHide_courseContent() {
                   1159:     var parmlevValue=document.getElementById("parmlev").value;
                   1160:     if (parmlevValue == 'general') {
                   1161:         document.getElementById('mapmenu').style.display="none";
                   1162:     } else {
                   1163:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1164:             document.getElementById('mapmenu').style.display ="";
                   1165:         } else {
                   1166:             document.getElementById('mapmenu').style.display="none";
                   1167:         }
                   1168:     }
                   1169:     return;
                   1170: }
                   1171: 
                   1172: COURSECONTENTSCRIPT
                   1173: }
                   1174: 
1.561     damieng  1175: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1176: sub toggleparmtextbox_js {
                   1177:     return <<"ENDSCRIPT";
                   1178: 
                   1179: if (!document.getElementsByClassName) {
                   1180:     function getElementsByClassName(node, classname) {
                   1181:         var a = [];
                   1182:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1183:         var els = node.getElementsByTagName("*");
                   1184:         for(var i=0,j=els.length; i<j; i++)
                   1185:             if(re.test(els[i].className))a.push(els[i]);
                   1186:         return a;
                   1187:     }
                   1188: }
                   1189: 
                   1190: function showHideLenient() {
                   1191:     var lenients;
                   1192:     var setRegExp = /^set_/;
                   1193:     if (document.getElementsByClassName) {
                   1194:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1195:     } else {
                   1196:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1197:     }
                   1198:     if (lenients != 'undefined') {
                   1199:         for (var i=0; i<lenients.length; i++) {
                   1200:             if (lenients[i].checked) {
                   1201:                 if (lenients[i].value == 'weighted') {
                   1202:                     if (setRegExp.test(lenients[i].name)) {
                   1203:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1204:                         toggleParmTextbox(document.parmform,identifier);
                   1205:                     }
                   1206:                 }
                   1207:             }
                   1208:         }
                   1209:     }
                   1210:     return;
                   1211: }
                   1212: 
                   1213: function toggleParmTextbox(form,key) {
                   1214:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1215:     if (divfortext) {
                   1216:         var caller = form.elements['set_'+key];
                   1217:         if (caller.length) {
                   1218:             for (i=0; i<caller.length; i++) {
                   1219:                 if (caller[i].checked) {
                   1220:                     if (caller[i].value == 'weighted') {
                   1221:                         divfortext.style.display = 'inline';
                   1222:                     } else {
                   1223:                         divfortext.style.display = 'none';
                   1224:                     }
                   1225:                 }
                   1226:             }
                   1227:         }
                   1228:     }
                   1229:     return;
                   1230: }
                   1231: 
                   1232: ENDSCRIPT
                   1233: }
                   1234: 
1.561     damieng  1235: # Javascript function validateParms, for overview mode
1.549     raeburn  1236: sub validateparms_js {
                   1237:     return <<'ENDSCRIPT';
                   1238: 
                   1239: function validateParms() {
                   1240:     var textRegExp = /^settext_/;
                   1241:     var tailLenient = /\.lenient$/;
                   1242:     var patternRelWeight = /^\-?[\d.]+$/;
                   1243:     var patternLenientStd = /^(yes|no|default)$/;
                   1244:     var ipallowRegExp = /^setipallow_/;
                   1245:     var ipdenyRegExp = /^setipdeny_/; 
1.588     raeburn  1246:     var deeplinkRegExp = /^deeplink_(listing|scope)_/;
                   1247:     var deeplinkUrlsRegExp = /^deeplink_urls_/;
                   1248:     var deeplinkltiRegExp = /^deeplink_lti_/;
                   1249:     var deeplinkkeyRegExp = /^deeplink_key_/;
1.549     raeburn  1250:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1251:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1252:         if (document.parmform.elements.length) {
                   1253:             for (i=0; i<document.parmform.elements.length; i++) {
                   1254:                 var name=document.parmform.elements[i].name;
1.588     raeburn  1255:                 if (textRegExp.test(name)) {
1.549     raeburn  1256:                     var identifier = name.replace(textRegExp,'');
                   1257:                     if (tailLenient.test(identifier)) {
                   1258:                         if (document.parmform.elements['set_'+identifier].length) {
                   1259:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1260:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1261:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1262:                                         var relweight = document.parmform.elements[i].value;
                   1263:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1264:                                         if (!patternRelWeight.test(relweight)) {
                   1265:                                             relweight = '0.0';
                   1266:                                         }
                   1267:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1268:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1269:                                         } else {
                   1270:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1271:                                         }
                   1272:                                     }
                   1273:                                     break;
                   1274:                                 }
                   1275:                             }
                   1276:                         }
                   1277:                     }
1.588     raeburn  1278:                 } else if (ipallowRegExp.test(name)) {
                   1279:                     var identifier = name.replace(ipallowRegExp,'');
                   1280:                     var possallow = document.parmform.elements[i].value;
                   1281:                     possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1282:                     if (patternIP.test(possallow)) {
                   1283:                         if (document.parmform.elements['set_'+identifier].value) {
                   1284:                             possallow = ','+possallow;
                   1285:                         }
                   1286:                         document.parmform.elements['set_'+identifier].value += possallow;
                   1287:                     }
                   1288:                 } else if (ipdenyRegExp.test(name)) {
                   1289:                     var identifier = name.replace(ipdenyRegExp,'');
                   1290:                     var possdeny = document.parmform.elements[i].value;
                   1291:                     possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1292:                     if (patternIP.test(possdeny)) {
                   1293:                         possdeny = '!'+possdeny;
                   1294:                         if (document.parmform.elements['set_'+identifier].value) {
                   1295:                             possdeny = ','+possdeny;
                   1296:                         }
                   1297:                         document.parmform.elements['set_'+identifier].value += possdeny;
                   1298:                     }
                   1299:                 } else if (deeplinkRegExp.test(name)) {
                   1300:                     var identifier =  name.replace(deeplinkRegExp,'');
                   1301:                     var possdeeplink = document.parmform.elements[i].value;
                   1302:                     possdeeplink = possdeeplink.replace(/^\s+|\s+$/g,'');
                   1303:                     if (document.parmform.elements['set_'+identifier].value) {
                   1304:                         possdeeplink = ','+possdeeplink;
                   1305:                     }
                   1306:                     document.parmform.elements['set_'+identifier].value += possdeeplink;
                   1307:                 } else if (deeplinkUrlsRegExp.test(name)) {
                   1308:                     if (document.parmform.elements[i].checked) {
                   1309:                         var identifier =  name.replace(deeplinkUrlsRegExp,'');
                   1310:                         var posslinkurl = document.parmform.elements[i].value;
                   1311:                         posslinkurl = posslinkurl.replace(/^\s+|\s+$/g,'');
                   1312:                         if (document.parmform.elements['set_'+identifier].value) {
                   1313:                             posslinkurl = ','+posslinkurl;
                   1314:                         }
                   1315:                         document.parmform.elements['set_'+identifier].value += posslinkurl;
                   1316:                     }
                   1317:                 } else if (deeplinkltiRegExp.test(name)) {
                   1318:                     var identifier = name.replace(deeplinkltiRegExp,'');
                   1319:                     var posslti = document.parmform.elements[i].value;
                   1320:                     posslti = posslti.replace(/\D+/g,'');
                   1321:                     if (document.parmform.elements['set_'+identifier].value) {
                   1322:                         posslti = ':'+posslti;
                   1323:                     }
                   1324:                     document.parmform.elements['set_'+identifier].value += posslti;
                   1325:                 } else if (deeplinkkeyRegExp.test(name)) {
                   1326:                     var identifier = name.replace(deeplinkkeyRegExp,'');
                   1327:                     var posskey = document.parmform.elements[i].value;
                   1328:                     posskey = posskey.replace(/\W+/g,'');
                   1329:                     if (document.parmform.elements['set_'+identifier].value) {
                   1330:                         posslti = ':'+posskey;
1.549     raeburn  1331:                     }
1.588     raeburn  1332:                     document.parmform.elements['set_'+identifier].value += posskey;
1.549     raeburn  1333:                 }
                   1334:             }
                   1335:         }
                   1336:     }
                   1337:     return true;
                   1338: }
                   1339: 
                   1340: ENDSCRIPT
                   1341: }
                   1342: 
1.561     damieng  1343: # Javascript initialization, for overview mode
1.549     raeburn  1344: sub ipacc_boxes_js  {
                   1345:     my $remove = &mt('Remove');
                   1346:     return <<"END";
                   1347: \$(document).ready(function() {
                   1348:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1349:     var add_button      = \$(".LC_add_ipacc_button");
                   1350:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1351: 
                   1352:     \$(add_button).click(function(e){
                   1353:         e.preventDefault();
                   1354:         var identifier = \$(this).closest("div").attr("id");
                   1355:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1356:         \$(this).closest('div').find('.LC_string_ipacc_inner').append('<div><input type="text" name="setip'+identifier+'" /><a href="#" class="LC_remove_ipacc">$remove</a></div>');
1.549     raeburn  1357:     });
                   1358: 
                   1359:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1360:         e.preventDefault(); \$(this).closest("div").remove();
                   1361:     })
                   1362: });
                   1363: 
                   1364: 
                   1365: END
                   1366: }
                   1367: 
1.561     damieng  1368: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1369: sub done_proctor_js {
                   1370:     return <<"END";
                   1371: function toggleSecret(form,radio,key) {
                   1372:     var radios = form[radio+key];
                   1373:     if (radios.length) {
                   1374:         for (var i=0; i<radios.length; i++) {
                   1375:             if (radios[i].checked) {
                   1376:                 if (radios[i].value == '_done_proctor') {
                   1377:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1378:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1379:                     }
                   1380:                 } else {
                   1381:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1382:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1383:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1384:                     }
                   1385:                 }
                   1386:             }
                   1387:         }
                   1388:     }
                   1389: }
                   1390: END
                   1391: 
                   1392: }
                   1393: 
1.588     raeburn  1394: # Javascript function toggle
                   1395: sub deeplink_js {
                   1396:     return <<"END";
                   1397: function toggleDeepLink(form,item,key) {
                   1398:     var radios = form['deeplink_'+item+'_'+key];
                   1399:     if (radios.length) {
                   1400:         var keybox;
                   1401:         if (document.getElementById('deeplink_key_'+item+'_'+key)) {
                   1402:             keybox = document.getElementById('deeplink_key_'+item+'_'+key);
                   1403:         }
                   1404:         var ltidiv;
                   1405:         if (document.getElementById('deeplinkdiv_lti_'+item+'_'+key)) {
                   1406:             ltidiv = document.getElementById('deeplinkdiv_lti_'+item+'_'+key);
                   1407:         }
                   1408:         for (var i=0; i<radios.length; i++) {
                   1409:             if (radios[i].checked) {
                   1410:                 if (radios[i].value == 'lti') {
                   1411:                     ltidiv.style.display = 'inline-block';
                   1412:                     keybox.type = 'hidden';
                   1413:                     keybox.value = '';
                   1414:                 } else {
                   1415:                     if (ltidiv != '') {
                   1416:                         ltidiv.style.display = 'none';
                   1417:                         form['deeplink_lti_'+key].selectedIndex = 0;
                   1418:                     }
                   1419:                     if (radios[i].value == 'key') {
                   1420:                         keybox.type = 'text';
                   1421:                     } else {
                   1422:                         keybox.type = 'hidden';
                   1423:                     }
                   1424:                 }
                   1425:             }
                   1426:         }
                   1427:     }
                   1428: }
                   1429: END
                   1430: 
                   1431: }
                   1432: 
1.561     damieng  1433: # Prints HTML page start for table mode.
                   1434: # @param {Apache2::RequestRec} $r - the Apache request
                   1435: # @param {string} $psymb - resource symb
                   1436: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1437: sub startpage {
1.531     raeburn  1438:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1439: 
1.515     raeburn  1440:     my %loaditems = (
                   1441:                       'onload'   => "group_or_section('cgroup')",
                   1442:                     );
                   1443:     if (!$psymb) {
1.523     raeburn  1444:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1445:     }
1.280     albertel 1446: 
1.560     damieng  1447:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1448:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1449:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1450:             text=>"Problem Parameters"});
1.414     droeschl 1451:     } else {
1.560     damieng  1452:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1453:             text=>"Table Mode",
                   1454:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1455:     }
1.523     raeburn  1456:     my $js = &page_js().'
                   1457: <script type="text/javascript">
                   1458: // <![CDATA[
                   1459: '.
                   1460:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1461: // ]]>
                   1462: </script>
                   1463: ';
1.446     bisitz   1464:     my $start_page =
1.523     raeburn  1465:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1466:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1467:     my $breadcrumbs =
1.473     amueller 1468:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1469:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1470:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1471:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1472:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1473:     $r->print(<<ENDHEAD);
1.193     albertel 1474: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1475: <input type="hidden" value="" name="pres_value" />
                   1476: <input type="hidden" value="" name="pres_type" />
                   1477: <input type="hidden" value="" name="pres_marker" />
                   1478: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1479: <input type="hidden" value="$escfilter" name="filter" />
                   1480: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1481: ENDHEAD
                   1482: }
                   1483: 
1.209     www      1484: 
1.561     damieng  1485: # Prints a row for table mode (except for the tr start).
                   1486: # Every time a hash reference is passed, a single entry is used, so print_row
                   1487: # could just use these values, but why make it simple when it can be complicated ?
                   1488: #
                   1489: # @param {Apache2::RequestRec} $r - the Apache request
                   1490: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1491: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1492: # @param {hash reference} $name - parameter key -> parameter name
1.566     damieng  1493: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561     damieng  1494: # @param {string} $rid - resource id
                   1495: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1496: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1497: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1498: # @param {string} $defbgone - user level and other levels background color
                   1499: # @param {string} $defbgtwo - section level background color, also used for part number
                   1500: # @param {string} $defbgthree - group level background color
                   1501: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1502: # @param {string} $uname - user name
                   1503: # @param {string} $udom - user domain
                   1504: # @param {string} $csec - section name
                   1505: # @param {string} $cgroup - group name
                   1506: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1507: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.582     raeburn  1508: # @param {boolean} $readonly - true if no editing allowed.
                   1509: # @param {array reference} - $recurseup - list of maps containing current one, ending at top-level.
                   1510: # @param {hash reference} - $maptitles - - hash map id or src -> map title 
                   1511: # @param {hash reference} - $allmaps_inverted - hash map src -> map pc
                   1512: # @param {scalar reference} - $reclinks - number of "parameter in effect" cells with link to map where recursive param was set 
1.44      albertel 1513: sub print_row {
1.201     www      1514:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568     raeburn  1515:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
1.582     raeburn  1516:     $readonly,$recurseup,$maptitles,$allmaps_inverted,$reclinks)=@_;
1.275     raeburn  1517:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1518:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1519:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.582     raeburn  1520:     my $numlinks = 0;
1.553     raeburn  1521: 
1.560     damieng  1522:     # get the values for the parameter in cascading order
                   1523:     # empty levels will remain empty
1.44      albertel 1524:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1525:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1526:     # get the type for the parameters
                   1527:     # problem: these may not be set for all levels
1.66      www      1528:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1529:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1530:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1531:     # cascade down manually
1.182     albertel 1532:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1533:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1534:         if ($typeoutpar[$i]) {
1.66      www      1535:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1536:         } else {
1.66      www      1537:             $typeoutpar[$i]=$cascadetype;
                   1538:         }
                   1539:     }
1.57      albertel 1540:     my $parm=$$display{$which};
                   1541: 
1.203     www      1542:     if ($parmlev eq 'full') {
1.419     bisitz   1543:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1544:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1545:     } else {
1.57      albertel 1546:         $parm=~s|\[.*\]\s||g;
                   1547:     }
1.231     www      1548:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1549:     if ($automatic) {
1.560     damieng  1550:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1551:     }
1.427     bisitz   1552:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1553: 
1.44      albertel 1554:     my $thismarker=$which;
                   1555:     $thismarker=~s/^parameter\_//;
                   1556:     my $mprefix=$rid.'&'.$thismarker.'&';
1.582     raeburn  1557:     my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1558:     my ($othergrp,$grp_parm,$controlgrp,$effective_parm,$effparm_rec,$effparm_level,
1.588     raeburn  1559:         $eff_groupparm,$recurse_check,$recursinfo,$extra);
1.582     raeburn  1560:     if ((ref($recurseup) eq 'ARRAY') && (@{$recurseup} > 0)) {
                   1561:         if ($result eq '') {
                   1562:             $recurse_check = 1;
                   1563:         } elsif (($uname ne '') && ($result > 3)) {
                   1564:             $recurse_check = 1;
                   1565:         } elsif (($cgroup ne '') && ($result > 7)) {
                   1566:             $recurse_check = 1;
                   1567:         } elsif (($csec ne '') && ($result > 11)) {
                   1568:             $recurse_check = 1;
                   1569:         } elsif ($result > 17) {
                   1570:             $recurse_check = 1;
                   1571:         }
                   1572:         if ($recurse_check) {
                   1573:             my $what = $$part{$which}.'.'.$$name{$which};
                   1574:             my $prefix;
                   1575:             if (($uname ne '') && ($udom ne '')) {
                   1576:                 my $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
                   1577:                 $prefix = $env{'request.course.id'};
                   1578:                 $recursinfo = &get_recursive($recurseup,$useropt,$what,$prefix);
                   1579:                 if (ref($recursinfo) eq 'ARRAY') {
                   1580:                     $effparm_rec = 1;
                   1581:                     $effparm_level = &mt('user: [_1]',$uname);
                   1582:                 }
                   1583:             }
                   1584:             if (($cgroup ne '') && (!$effparm_rec)) {
                   1585:                 $prefix = $env{'request.course.id'}.'.['.$cgroup.']';
                   1586:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1587:                 if (ref($recursinfo) eq 'ARRAY') {
                   1588:                     $effparm_rec = 1;
                   1589:                     $effparm_level = &mt('group: [_1]',$cgroup);
                   1590:                 }
                   1591:             }
                   1592:             if (($csec ne '') && (!$effparm_rec)) {
                   1593:                 $prefix = $env{'request.course.id'}.'.['.$csec.']';
                   1594:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1595:                 if (ref($recursinfo) eq 'ARRAY') {
                   1596:                     $effparm_rec = 1;
                   1597:                     $effparm_level = &mt('section: [_1]',$csec);
                   1598:                 }
                   1599:             }
                   1600:             if (!$effparm_rec) {
                   1601:                 $prefix = $env{'request.course.id'};
                   1602:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix); 
                   1603:                 if (ref($recursinfo) eq 'ARRAY') {
                   1604:                     $effparm_rec = 1;
                   1605:                 }
                   1606:             }
                   1607:         }
                   1608:     }
                   1609:     if ((!$effparm_rec) && ($result == 17 || $result == 11 || $result == 7 || $result == 3)) {
                   1610:         $effparm_rec = 1;
                   1611:     }
                   1612:     if ((!$effparm_rec) && 
                   1613:         (($$name{$which} eq 'encrypturl') || ($$name{$which} eq 'hiddenresource')) && 
                   1614:         ($result == 16 || $result == 10 || $result == 6 || $result == 2)) {
1.578     raeburn  1615:         $effparm_rec = 1;
                   1616:     }
1.588     raeburn  1617:     if ($parmname eq 'deeplink') {
                   1618:         my %posslti;
                   1619:         my %lti =
                   1620:             &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   1621:                                             'provider');
                   1622:         foreach my $item (keys(%lti)) {
                   1623:             if (ref($lti{$item}) eq 'HASH') {
                   1624:                 unless ($lti{$item}{'requser'}) {
                   1625:                     $posslti{$item} = $lti{$item}{'consumer'};
                   1626:                 }
                   1627:             }
                   1628:         }
                   1629:         if (keys(%posslti)) {
                   1630:             $extra = 'lti_';
                   1631:             foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   1632:                 $extra .= $lti.':'.&js_escape($posslti{$lti}).',';
                   1633:             }
                   1634:             $extra =~ s/,$//;
                   1635:         }
                   1636:     }
1.57      albertel 1637:     if ($parmlev eq 'general') {
                   1638:         if ($uname) {
1.588     raeburn  1639:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.269     raeburn  1640:         } elsif ($cgroup) {
1.588     raeburn  1641:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
1.57      albertel 1642:         } elsif ($csec) {
1.588     raeburn  1643:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1644:         } else {
1.588     raeburn  1645:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1646:         }
                   1647:     } elsif ($parmlev eq 'map') {
                   1648:         if ($uname) {
1.588     raeburn  1649:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.269     raeburn  1650:         } elsif ($cgroup) {
1.588     raeburn  1651:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
1.57      albertel 1652:         } elsif ($csec) {
1.588     raeburn  1653:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1654:         } else {
1.588     raeburn  1655:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1656:         }
                   1657:     } else {
1.275     raeburn  1658:         if ($uname) {
                   1659:             if (@{$usersgroups} > 1) {
1.582     raeburn  1660:                 (my $coursereply,$othergrp,$grp_parm,$controlgrp,my $grp_is_rec) =
1.580     raeburn  1661:                     &check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1662:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.582     raeburn  1663:                 if (($coursereply) && ($result > 4)) {
1.275     raeburn  1664:                     if (defined($controlgrp)) {
                   1665:                         if ($cgroup ne $controlgrp) {
1.582     raeburn  1666:                             $eff_groupparm = $grp_parm;
                   1667:                             undef($result);
                   1668:                             undef($effparm_rec);
                   1669:                             if ($grp_is_rec) {
                   1670:                                  $effparm_rec = 1;
                   1671:                             }
1.275     raeburn  1672:                         }
                   1673:                     }
                   1674:                 }
                   1675:             }
                   1676:         }
1.57      albertel 1677: 
1.588     raeburn  1678:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1679:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1680:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1681:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1682:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1683: 
                   1684:         if ($csec) {
1.588     raeburn  1685:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1686:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1687:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1688:         }
1.269     raeburn  1689: 
                   1690:         if ($cgroup) {
1.588     raeburn  1691:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
                   1692:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
                   1693:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly,'',$extra);
1.269     raeburn  1694:         }
1.446     bisitz   1695: 
1.548     raeburn  1696:         if ($uname) {
1.275     raeburn  1697:             if ($othergrp) {
                   1698:                 $r->print($othergrp);
                   1699:             }
1.588     raeburn  1700:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1701:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1702:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1703:         }
1.57      albertel 1704:     } # end of $parmlev if/else
1.582     raeburn  1705:     if (ref($recursinfo) eq 'ARRAY') {
                   1706:         my $rectitle = &mt('recursive');
                   1707:         if ((ref($maptitles) eq 'HASH') && (exists($maptitles->{$recursinfo->[2]}))) {
                   1708:             if ((ref($allmaps_inverted) eq 'HASH') && (exists($allmaps_inverted->{$recursinfo->[2]}))) {
                   1709:                 $rectitle = &mt('set in: [_1]','"'.
                   1710:                                 '<a href="javascript:pjumprec('."'".$allmaps_inverted->{$recursinfo->[2]}."',".
                   1711:                                                               "'$parmname','$$part{$which}'".');">'.
                   1712:                                 $maptitles->{$recursinfo->[2]}.'</a>"');
                   1713:               
                   1714:                 $numlinks ++;
                   1715:             }
                   1716:         }
                   1717:         my ($parmname)=($thismarker=~/\_([^\_]+)$/);
1.593   ! raeburn  1718:         $effective_parm = &valout($recursinfo->[0],$recursinfo->[1]);
1.582     raeburn  1719:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1720:                   '<br /><span class="LC_parm_recursive">'.$rectitle.'&nbsp;'.
                   1721:                   $effparm_level.'</span></td>');
                   1722:     } else {
                   1723:         if ($result) {
1.593   ! raeburn  1724:             $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
1.582     raeburn  1725:         }
                   1726:         if ($eff_groupparm) {
                   1727:             $effective_parm = $eff_groupparm;
                   1728:         }
                   1729:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1730:                   ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
                   1731:                                 '</span>':'').'</td>');
                   1732:     }
1.203     www      1733:     if ($parmlev eq 'full') {
1.136     albertel 1734:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1735:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1736:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1737:         if (!defined($sessionvaltype)) {
                   1738:             $sessionvaltype=$$defaulttype{$which};
                   1739:         }
1.419     bisitz   1740:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.593   ! raeburn  1741:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel 1742:                   '</font></td>');
1.136     albertel 1743:     }
1.44      albertel 1744:     $r->print('</tr>');
1.57      albertel 1745:     $r->print("\n");
1.582     raeburn  1746:     if (($numlinks) && (ref($reclinks))) {
                   1747:         $$reclinks = $numlinks;
                   1748:     }
1.44      albertel 1749: }
1.59      matthew  1750: 
1.561     damieng  1751: # Prints a cell for table mode.
                   1752: #
                   1753: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1754: # Also, it would make more sense to pass the display for this cell rather
                   1755: # than the full display hash and the key to use.
                   1756: #
                   1757: # @param {Apache2::RequestRec} $r - the Apache request
                   1758: # @param {integer} $which - level
                   1759: # @param {string} $defbg - cell background color
                   1760: # @param {integer} $result - the most specific level that is defined for that parameter
                   1761: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1762: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1763: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1764: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1765: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1766: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1767: # @param {boolean} $readonly -true if editing not allowed.
1.588     raeburn  1768: # @param {boolean} $ismaplevel - true if level is for a map.
                   1769: # @param {strring} $extra - extra informatio to pass to plink.
1.44      albertel 1770: sub print_td {
1.578     raeburn  1771:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
1.588     raeburn  1772:         $noeditgrp,$readonly,$ismaplevel,$extra)=@_;
1.578     raeburn  1773:     my ($ineffect,$recursive,$currval,$currtype,$currlevel);
                   1774:     $ineffect = 0;
                   1775:     $currval = $$outpar[$which];
                   1776:     $currtype = $$typeoutpar[$which];
                   1777:     $currlevel = $which;
                   1778:     if (($result) && ($result == $which)) {
                   1779:         $ineffect = 1;
                   1780:     } 
                   1781:     if ($ismaplevel) {
                   1782:         if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
                   1783:             if (($result) && ($result == $which)) {
                   1784:                 $recursive = 1;
                   1785:             }
                   1786:         } elsif ($$outpar[$which+1] ne '') {
                   1787:             $recursive = 1;
                   1788:             $currlevel = $which+1;
                   1789:             $currval = $$outpar[$currlevel];
                   1790:             $currtype = $$typeoutpar[$currlevel];
                   1791:             if (($result) && ($result == $currlevel)) {
                   1792:                 $ineffect = 1;
                   1793:             }
                   1794:         }
                   1795:     }
                   1796:     $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419     bisitz   1797:               ';" align="center">');
1.437     raeburn  1798:     my $nolink = 0;
1.568     raeburn  1799:     if ($readonly) {
1.552     raeburn  1800:         $nolink = 1;
1.568     raeburn  1801:     } else { 
1.578     raeburn  1802:         if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553     raeburn  1803:             $nolink = 1;
1.568     raeburn  1804:         } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533     raeburn  1805:             $nolink = 1;
1.568     raeburn  1806:         } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
                   1807:             if ($noeditgrp) {
                   1808:                 $nolink = 1;
                   1809:             }
                   1810:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1811:             if ($which > 4) {
                   1812:                 $nolink = 1;
                   1813:             }
                   1814:         } elsif ($mprefix =~ /examcode\&$/) {
                   1815:             unless ($which == 2) {
                   1816:                 $nolink = 1;
                   1817:             }
1.533     raeburn  1818:         }
1.437     raeburn  1819:     }
                   1820:     if ($nolink) {
1.577     raeburn  1821:         my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.593   ! raeburn  1822:         $r->print(&valout($currval,$currtype));
1.114     www      1823:     } else {
1.578     raeburn  1824:         $r->print(&plink($currtype,
                   1825:                          $$display{$value},$currval,
1.588     raeburn  1826:                          $mprefix.$currlevel,'parmform.pres','psub',$recursive,
                   1827:                          $extra));
1.114     www      1828:     }
                   1829:     $r->print('</td>'."\n");
1.57      albertel 1830: }
                   1831: 
1.561     damieng  1832: # Returns HTML and other info for the cell added when a user is selected
                   1833: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1834: #
                   1835: # @param {string} $what - parameter part.'.'.parameter name
                   1836: # @param {string} $rid - resource id
                   1837: # @param {string} $cgroup - group name
                   1838: # @param {string} $defbg - cell background color
                   1839: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1840: # @param {integer} $result - level
                   1841: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
1.582     raeburn  1842: # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group, true if recursive)
1.580     raeburn  1843: sub check_other_groups {
                   1844:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1845:     my $courseid = $env{'request.course.id'};
                   1846:     my $output;
                   1847:     my $symb = &symbcache($rid);
                   1848:     my $symbparm=$symb.'.'.$what;
                   1849:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1850:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1851:     my $mapparm=$map.'___(all).'.$what;
                   1852:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1853:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1854:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1855:     my $bgcolor = $defbg;
1.582     raeburn  1856:     my ($grp_parm,$grp_is_rec);
1.446     bisitz   1857:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.582     raeburn  1858:         my ($parmname) = ($what =~ /\.([^.]+)$/);
1.275     raeburn  1859:         if ($result > 3) {
1.419     bisitz   1860:             $bgcolor = '#AAFFAA';
1.275     raeburn  1861:         }
1.593   ! raeburn  1862:         $grp_parm = &valout($coursereply,$resulttype);
1.419     bisitz   1863:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1864:         if ($resultgroup && $resultlevel) {
1.582     raeburn  1865:             if ($resultlevel eq 'recursive') {
                   1866:                 $resultlevel = 'map/folder';
                   1867:                 $grp_is_rec = 1;
                   1868:             }
                   1869:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm.
                   1870:                        ($grp_is_rec?'<span class="LC_parm_recursive">'.&mt('recursive').'</span>':'');
                   1871:              
1.275     raeburn  1872:         } else {
                   1873:             $output .= '&nbsp;';
                   1874:         }
                   1875:         $output .= '</td>';
                   1876:     } else {
1.419     bisitz   1877:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1878:     }
1.582     raeburn  1879:     return ($coursereply,$output,$grp_parm,$resultgroup,$grp_is_rec);
1.275     raeburn  1880: }
                   1881: 
1.561     damieng  1882: # Looks for a group with a defined parameter for given user and parameter.
1.580     raeburn  1883: # Used by check_other_groups.
1.561     damieng  1884: #
                   1885: # @param {string} $courseid - the course id
                   1886: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1887: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1888: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1889: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1890: # @param {string} $what - parameter part.'.'.parameter name
                   1891: # @param {hash reference} $courseopt - course parameters hash
                   1892: # @returns {Array} - (parameter value for the group, course parameter hash key for the parameter, name of the group, level name, parameter type)
1.275     raeburn  1893: sub parm_control_group {
1.556     raeburn  1894:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1895:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1896:     my $grpfound = 0;
1.556     raeburn  1897:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1898:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1899:     foreach my $group (@{$usersgroups}) {
                   1900:         if ($grpfound) { last; }
                   1901:         for (my $i=0; $i<@levels; $i++) {
                   1902:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1903:             if (defined($$courseopt{$item})) {
                   1904:                 $coursereply = $$courseopt{$item};
                   1905:                 $resultitem = $item;
                   1906:                 $resultgroup = $group;
                   1907:                 $resultlevel = $levelnames[$i];
                   1908:                 $resulttype = $$courseopt{$item.'.type'};
                   1909:                 $grpfound = 1;
                   1910:                 last;
                   1911:             }
                   1912:         }
                   1913:     }
                   1914:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1915: }
1.201     www      1916: 
1.63      bowersj2 1917: 
                   1918: 
1.562     damieng  1919: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1920: # All the parameters are references and are filled by the sub.
                   1921: #
1.566     damieng  1922: # @param {array reference} $ids - resource and map ids
                   1923: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
                   1924: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562     damieng  1925: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1926: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566     damieng  1927: # @param {hash reference} $allmaps - hash map pc -> map src
                   1928: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
                   1929: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
                   1930: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
                   1931: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562     damieng  1932: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1933: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1934: sub extractResourceInformation {
                   1935:     my $ids = shift;
                   1936:     my $typep = shift;
                   1937:     my $keyp = shift;
                   1938:     my $allparms = shift;
                   1939:     my $allparts = shift;
                   1940:     my $allmaps = shift;
                   1941:     my $mapp = shift;
                   1942:     my $symbp = shift;
1.82      www      1943:     my $maptitles=shift;
1.196     www      1944:     my $uris=shift;
1.210     www      1945:     my $keyorder=shift;
1.211     www      1946:     my $defkeytype=shift;
1.196     www      1947: 
1.210     www      1948:     my $keyordercnt=100;
1.63      bowersj2 1949: 
1.196     www      1950:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1951:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1952:     foreach my $resource (@allres) {
1.480     amueller 1953:         my $id=$resource->id();
1.196     www      1954:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1955:         if ($mapid eq '0') { next; }
                   1956:         $$ids[$#$ids+1]=$id;
                   1957:         my $srcf=$resource->src();
                   1958:         $srcf=~/\.(\w+)$/;
                   1959:         $$typep{$id}=$1;
1.584     raeburn  1960:         my $toolsymb;
                   1961:         if ($srcf =~ /ext\.tool$/) {
                   1962:             $toolsymb = $resource->symb();
                   1963:         }
1.480     amueller 1964:         $$keyp{$id}='';
1.196     www      1965:         $$uris{$id}=$srcf;
1.512     foxr     1966: 
1.584     raeburn  1967:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys',$toolsymb))) {
1.480     amueller 1968:             next if ($key!~/^parameter_/);
1.363     albertel 1969: 
1.209     www      1970: # Hidden parameters
1.584     raeburn  1971:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden',$toolsymb) eq 'parm');
1.209     www      1972: #
                   1973: # allparms is a hash of parameter names
                   1974: #
1.584     raeburn  1975:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name',$toolsymb);
1.480     amueller 1976:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1977:                 my ($display,$parmdis);
                   1978:                 $display = &standard_parameter_names($name);
                   1979:                 if ($display eq '') {
1.584     raeburn  1980:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display',$toolsymb);
1.480     amueller 1981:                     $parmdis = $display;
                   1982:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1983:                 } else {
                   1984:                     $parmdis = &mt($display);
                   1985:                 }
                   1986:                 $$allparms{$name}=$parmdis;
                   1987:                 if (ref($defkeytype)) {
                   1988:                     $$defkeytype{$name}=
1.584     raeburn  1989:                     &Apache::lonnet::metadata($srcf,$key.'.type',$toolsymb);
1.480     amueller 1990:                 }
                   1991:             }
1.363     albertel 1992: 
1.209     www      1993: #
                   1994: # allparts is a hash of all parts
                   1995: #
1.584     raeburn  1996:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part',$toolsymb);
1.480     amueller 1997:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1998: #
                   1999: # Remember all keys going with this resource
                   2000: #
1.480     amueller 2001:             if ($$keyp{$id}) {
                   2002:                 $$keyp{$id}.=','.$key;
                   2003:             } else {
                   2004:                 $$keyp{$id}=$key;
                   2005:             }   
1.210     www      2006: #
                   2007: # Put in order
1.446     bisitz   2008: #
1.480     amueller 2009:             unless ($$keyorder{$key}) {
                   2010:                 $$keyorder{$key}=$keyordercnt;
                   2011:                 $keyordercnt++;
                   2012:             }
1.473     amueller 2013:         }
                   2014: 
                   2015: 
1.480     amueller 2016:         if (!exists($$mapp{$mapid})) {
                   2017:             $$mapp{$id}=
                   2018:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   2019:             $$mapp{$mapid}=$$mapp{$id};
                   2020:             $$allmaps{$mapid}=$$mapp{$id};
                   2021:             if ($mapid eq '1') {
1.532     raeburn  2022:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 2023:             } else {
                   2024:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   2025:             }
                   2026:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  2027:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   2028:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   2029:                                                      # are commented out in rev. 1.57
1.473     amueller 2030:         } else {
1.480     amueller 2031:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 2032:         }
1.480     amueller 2033:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 2034:     }
                   2035: }
                   2036: 
1.582     raeburn  2037: sub get_recursive {
                   2038:     my ($recurseup,$resdata,$what,$prefix) = @_; 
                   2039:     if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
                   2040:         foreach my $item (@{$recurseup}) {
                   2041:             my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
                   2042:             if (defined($resdata->{$norecursechk})) {
                   2043:                 if ($what =~ /\.(encrypturl|hiddenresource)$/) {
                   2044:                     my $type = $resdata->{$norecursechk.'.type'};
                   2045:                     return [$resdata->{$norecursechk},$type,$item];
                   2046:                 } else {
                   2047:                     last;
                   2048:                 }
                   2049:             }
                   2050:             my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
                   2051:             if (defined($resdata->{$recursechk})) {
                   2052:                 my $type = $resdata->{$recursechk.'.type'};
                   2053:                 return [$resdata->{$recursechk},$type,$item];
                   2054:             }
                   2055:         }
                   2056:     }
                   2057:     return;
                   2058: }
                   2059: 
1.208     www      2060: 
1.562     damieng  2061: # Tells if a parameter type is a date.
                   2062: #
                   2063: # @param {string} type - parameter type
                   2064: # @returns{boolean} - true if it is a date
1.213     www      2065: sub isdateparm {
                   2066:     my $type=shift;
                   2067:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   2068: }
                   2069: 
1.589     raeburn  2070: # Determine if parameter type is specialized string type (i.e.,
                   2071: # not just string or string_yesno.  
                   2072: 
                   2073: sub is_specialstring {
                   2074:     my $type=shift;
1.590     raeburn  2075:     return (($type=~/^string_/) && (($type ne 'string_yesno')));
1.589     raeburn  2076: }
                   2077: 
1.562     damieng  2078: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 2079: #
1.581     raeburn  2080: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      2081: sub parmmenu {
1.581     raeburn  2082:     my ($r)=@_;
1.208     www      2083:     $r->print(<<ENDSCRIPT);
                   2084: <script type="text/javascript">
1.454     bisitz   2085: // <![CDATA[
1.208     www      2086:     function checkall(value, checkName) {
1.453     schualex 2087: 
                   2088:         var li = "_li";
                   2089:         var displayOverview = "";
                   2090:         
                   2091:         if (value == false) {
                   2092:             displayOverview = "none"
                   2093:         }
                   2094: 
1.562     damieng  2095:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      2096:             ele = document.forms.parmform.elements[i];
                   2097:             if (ele.name == checkName) {
                   2098:                 document.forms.parmform.elements[i].checked=value;
                   2099:             }
                   2100:         }
                   2101:     }
1.210     www      2102: 
                   2103:     function checkthis(thisvalue, checkName) {
1.562     damieng  2104:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      2105:             ele = document.forms.parmform.elements[i];
                   2106:             if (ele.name == checkName) {
1.562     damieng  2107:                 if (ele.value == thisvalue) {
                   2108:                     document.forms.parmform.elements[i].checked=true;
                   2109:                 }
1.210     www      2110:             }
                   2111:         }
                   2112:     }
                   2113: 
                   2114:     function checkdates() {
1.562     damieng  2115:         checkthis('duedate','pscat');
                   2116:         checkthis('opendate','pscat');
                   2117:         checkthis('answerdate','pscat');
1.218     www      2118:     }
                   2119: 
                   2120:     function checkdisset() {
1.562     damieng  2121:         checkthis('discussend','pscat');
                   2122:         checkthis('discusshide','pscat');
                   2123:         checkthis('discussvote','pscat');
1.218     www      2124:     }
                   2125: 
                   2126:     function checkcontdates() {
1.562     damieng  2127:         checkthis('contentopen','pscat');
                   2128:         checkthis('contentclose','pscat');
1.218     www      2129:     }
1.446     bisitz   2130: 
1.210     www      2131:     function checkvisi() {
1.562     damieng  2132:         checkthis('hiddenresource','pscat');
                   2133:         checkthis('encrypturl','pscat');
                   2134:         checkthis('problemstatus','pscat');
                   2135:         checkthis('contentopen','pscat');
                   2136:         checkthis('opendate','pscat');
1.210     www      2137:     }
                   2138: 
                   2139:     function checkparts() {
1.562     damieng  2140:         checkthis('hiddenparts','pscat');
                   2141:         checkthis('display','pscat');
                   2142:         checkthis('ordered','pscat');
1.210     www      2143:     }
                   2144: 
                   2145:     function checkstandard() {
                   2146:         checkall(false,'pscat');
1.562     damieng  2147:         checkdates();
                   2148:         checkthis('weight','pscat');
                   2149:         checkthis('maxtries','pscat');
                   2150:         checkthis('type','pscat');
                   2151:         checkthis('problemstatus','pscat');
1.210     www      2152:     }
                   2153: 
1.454     bisitz   2154: // ]]>
1.208     www      2155: </script>
                   2156: ENDSCRIPT
1.453     schualex 2157: 
1.491     bisitz   2158:     $r->print('<hr />');
1.581     raeburn  2159:     &shortCuts($r);
1.491     bisitz   2160:     $r->print('<hr />');
1.453     schualex 2161: }
1.562     damieng  2162: 
                   2163: # Returns parameter categories.
                   2164: #
                   2165: # @returns {hash} - category name -> title in English
1.465     amueller 2166: sub categories {
                   2167:     return ('time_settings' => 'Time Settings',
                   2168:     'grading' => 'Grading',
                   2169:     'tries' => 'Tries',
                   2170:     'problem_appearance' => 'Problem Appearance',
                   2171:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   2172:     'hiding' => 'Hiding',
                   2173:     'high_level_randomization' => 'High Level Randomization',
                   2174:     'slots' => 'Slots',
                   2175:     'file_submission' => 'File Submission',
                   2176:     'misc' => 'Miscellaneous' ); 
                   2177: }
                   2178: 
1.562     damieng  2179: # Returns the category for each parameter.
                   2180: #
                   2181: # @returns {hash} - parameter name -> category name
1.465     amueller 2182: sub lookUpTableParameter {
                   2183:  
                   2184:     return ( 
                   2185:         'opendate' => 'time_settings',
                   2186:         'duedate' => 'time_settings',
                   2187:         'answerdate' => 'time_settings',
                   2188:         'interval' => 'time_settings',
                   2189:         'contentopen' => 'time_settings',
                   2190:         'contentclose' => 'time_settings',
                   2191:         'discussend' => 'time_settings',
1.560     damieng  2192:         'printstartdate' => 'time_settings',
                   2193:         'printenddate' => 'time_settings',
1.465     amueller 2194:         'weight' => 'grading',
                   2195:         'handgrade' => 'grading',
                   2196:         'maxtries' => 'tries',
                   2197:         'hinttries' => 'tries',
1.503     raeburn  2198:         'randomizeontries' => 'tries',
1.465     amueller 2199:         'type' => 'problem_appearance',
                   2200:         'problemstatus' => 'problem_appearance',
                   2201:         'display' => 'problem_appearance',
                   2202:         'ordered' => 'problem_appearance',
                   2203:         'numbubbles' => 'problem_appearance',
                   2204:         'tol' => 'behaviour_of_input_fields',
                   2205:         'sig' => 'behaviour_of_input_fields',
                   2206:         'turnoffunit' => 'behaviour_of_input_fields',
                   2207:         'hiddenresource' => 'hiding',
                   2208:         'hiddenparts' => 'hiding',
                   2209:         'discusshide' => 'hiding',
                   2210:         'buttonshide' => 'hiding',
                   2211:         'turnoffeditor' => 'hiding',
                   2212:         'encrypturl' => 'hiding',
1.587     raeburn  2213:         'deeplink' => 'hiding',
1.465     amueller 2214:         'randomorder' => 'high_level_randomization',
                   2215:         'randompick' => 'high_level_randomization',
                   2216:         'available' => 'slots',
                   2217:         'useslots' => 'slots',
                   2218:         'availablestudent' => 'slots',
                   2219:         'uploadedfiletypes' => 'file_submission',
                   2220:         'maxfilesize' => 'file_submission',
                   2221:         'cssfile' => 'misc',
                   2222:         'mapalias' => 'misc',
                   2223:         'acc' => 'misc',
                   2224:         'maxcollaborators' => 'misc',
                   2225:         'scoreformat' => 'misc',
1.514     raeburn  2226:         'lenient' => 'grading',
1.519     raeburn  2227:         'retrypartial' => 'tries',
1.521     raeburn  2228:         'discussvote'  => 'misc',
1.584     raeburn  2229:         'examcode' => 'high_level_randomization',
1.575     raeburn  2230:     );
1.465     amueller 2231: }
                   2232: 
1.562     damieng  2233: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2234: #
                   2235: # @param {string} $name - parameter name
                   2236: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2237: sub whatIsMyCategory {
                   2238:     my $name = shift;
                   2239:     my $catList = shift;
                   2240:     my @list;
                   2241:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2242:     my $cat = $lookUpList{$name};
                   2243:     if (defined($cat)) {
                   2244:         if (!defined($$catList{$cat})){
                   2245:             push @list, ($name);
                   2246:             $$catList{$cat} = \@list;
                   2247:         } else {
                   2248:             push @{${$catList}{$cat}}, ($name);     
                   2249:         }
                   2250:     } else {
                   2251:         if (!defined($$catList{'misc'})){
                   2252:             push @list, ($name);
                   2253:             $$catList{'misc'} = \@list;
                   2254:         } else {
                   2255:             push @{${$catList}{'misc'}}, ($name);     
                   2256:         }
                   2257:     }        
                   2258: }
                   2259: 
1.562     damieng  2260: # Sorts parameter names based on appearance order.
                   2261: #
                   2262: # @param {array reference} name - array reference of parameter names
                   2263: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2264: # @returns {Array} - array of parameter names
1.465     amueller 2265: sub keysindisplayorderCategory {
                   2266:     my ($name,$keyorder)=@_;
                   2267:     return sort {
1.473     amueller 2268:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2269:     } ( @{$name});
                   2270: }
                   2271: 
1.562     damieng  2272: # Returns a hash category name -> order, starting at 1 (integer)
                   2273: #
                   2274: # @returns {hash}
1.467     amueller 2275: sub category_order {
                   2276:     return (
                   2277:         'time_settings' => 1,
                   2278:         'grading' => 2,
                   2279:         'tries' => 3,
                   2280:         'problem_appearance' => 4,
                   2281:         'hiding' => 5,
                   2282:         'behaviour_of_input_fields' => 6,
                   2283:         'high_level_randomization'  => 7,
                   2284:         'slots' => 8,
                   2285:         'file_submission' => 9,
                   2286:         'misc' => 10
                   2287:     );
                   2288: 
                   2289: }
1.453     schualex 2290: 
1.562     damieng  2291: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2292: #
                   2293: # @param {Apache2::RequestRec} $r - the Apache request
                   2294: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2295: # @param {array reference} $pscat - list of selected parameter names
                   2296: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2297: sub parmboxes {
                   2298:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2299:     my %categories = &categories();
1.467     amueller 2300:     my %category_order = &category_order();
1.465     amueller 2301:     my %categoryList = (
                   2302:         'time_settings' => [],
                   2303:         'grading' => [],
                   2304:         'tries' => [],
                   2305:         'problem_appearance' => [],
                   2306:         'behaviour_of_input_fields' => [],
                   2307:         'hiding' => [],
                   2308:         'high_level_randomization' => [],
                   2309:         'slots' => [],
                   2310:         'file_submission' => [],
                   2311:         'misc' => [],
1.489     bisitz   2312:     );
1.510     www      2313: 
1.548     raeburn  2314:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2315:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2316:     }
1.453     schualex 2317:     #part to print the parm-list
1.536     raeburn  2318:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2319:         next if (@{$categoryList{$key}} == 0);
                   2320:         next if ($key eq '');
                   2321:         $r->print('<div class="LC_Box LC_400Box">'
                   2322:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2323:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2324:             next if ($tempkey eq '');
1.536     raeburn  2325:             $r->print('<span class="LC_nobreak">'
                   2326:                      .'<label><input type="checkbox" name="pscat" '
                   2327:                      .'value="'.$tempkey.'" ');
                   2328:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2329:                 $r->print( ' checked="checked"');
                   2330:             }
                   2331:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2332:                                                       : $tempkey)
1.536     raeburn  2333:                      .'</label></span><br />'."\n");
1.465     amueller 2334:         }
1.536     raeburn  2335:         $r->print('</div>');
1.465     amueller 2336:     }
1.536     raeburn  2337:     $r->print("\n");
1.453     schualex 2338: }
1.562     damieng  2339: 
                   2340: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2341: #
1.562     damieng  2342: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2343: sub shortCuts {
1.581     raeburn  2344:     my ($r)=@_;
1.453     schualex 2345: 
1.491     bisitz   2346:     # Parameter Selection
                   2347:     $r->print(
                   2348:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2349:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2350:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2351:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2352:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2353:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2354:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2355:        .&Apache::lonhtmlcommon::end_funclist()
                   2356:     );
                   2357: 
                   2358:     # Add Selection for...
                   2359:     $r->print(
                   2360:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2361:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2362:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2363:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2364:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2365:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2366:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2367:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2368:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2369:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2370:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2371:        .&Apache::lonhtmlcommon::end_funclist()
                   2372:     );
1.208     www      2373: }
                   2374: 
1.562     damieng  2375: # Prints HTML to select parts to view (except for the title).
                   2376: # Used by table and overview modes.
                   2377: #
                   2378: # @param {Apache2::RequestRec} $r - the Apache request
                   2379: # @param {hash reference} $allparts - hash parameter part -> part title
                   2380: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2381: sub partmenu {
1.446     bisitz   2382:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2383:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2384:     if ($selsize > 8) {
                   2385:         $selsize = 8;
                   2386:     }
1.446     bisitz   2387: 
1.523     raeburn  2388:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2389:     $r->print('<option value="all"');
1.562     damieng  2390:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2391:     $r->print('>'.&mt('All Parts').'</option>');
                   2392:     my %temphash=();
                   2393:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2394:     foreach my $tempkey (sort {
1.560     damieng  2395:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2396:             } keys(%{$allparts})) {
                   2397:         unless ($tempkey =~ /\./) {
                   2398:             $r->print('<option value="'.$tempkey.'"');
                   2399:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2400:                 $r->print(' selected="selected"');
                   2401:             }
                   2402:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2403:         }
1.208     www      2404:     }
1.446     bisitz   2405:     $r->print('</select>');
1.209     www      2406: }
                   2407: 
1.562     damieng  2408: # Prints HTML to select a user and/or a group.
                   2409: # Used by table mode.
                   2410: #
                   2411: # @param {Apache2::RequestRec} $r - the Apache request
                   2412: # @param {string} $uname - selected user name
                   2413: # @param {string} $id - selected Student/Employee ID
                   2414: # @param {string} $udom - selected user domain
                   2415: # @param {string} $csec - selected section name
                   2416: # @param {string} $cgroup - selected group name
                   2417: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2418: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2419: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2420: sub usermenu {
1.553     raeburn  2421:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2422:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2423:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2424:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2425: 
1.209     www      2426:     my $sections='';
1.300     albertel 2427:     my %sectionhash = &Apache::loncommon::get_sections();
                   2428: 
1.269     raeburn  2429:     my $groups;
1.553     raeburn  2430:     my %grouphash;
                   2431:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2432:         %grouphash = &Apache::longroup::coursegroups();
                   2433:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2434:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2435:     }
1.299     albertel 2436: 
1.412     bisitz   2437:     my $g_s_header='';
                   2438:     my $g_s_footer='';
1.446     bisitz   2439: 
1.552     raeburn  2440:     my $currsec = $env{'request.course.sec'};
                   2441:     if ($currsec) {
                   2442:         $sections=&mt('Section:').' '.$currsec;
                   2443:         if (%grouphash) {
                   2444:             $sections .= ';'.('&nbsp;' x2);
                   2445:         }
                   2446:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2447:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2448:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2449:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2450:         }
                   2451:         $sections .= '>';
1.548     raeburn  2452:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2453:         $sections.='<option value="'.$section.'" '.
                   2454:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2455:                                                               '</option>';
1.209     www      2456:         }
                   2457:         $sections.='</select>';
1.269     raeburn  2458:     }
1.412     bisitz   2459: 
1.552     raeburn  2460:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2461:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2462:         $sections .= qq|
                   2463: <script type="text/javascript">
1.454     bisitz   2464: // <![CDATA[
1.269     raeburn  2465: function group_or_section(caller) {
                   2466:    if (caller == "cgroup") {
                   2467:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2468:            document.parmform.csec.selectedIndex = 0;
                   2469:        }
                   2470:    } else {
                   2471:        if (document.parmform.csec.selectedIndex != 0) {
                   2472:            document.parmform.cgroup.selectedIndex = 0;
                   2473:        }
                   2474:    }
                   2475: }
1.454     bisitz   2476: // ]]>
1.269     raeburn  2477: </script>
                   2478: |;
1.554     raeburn  2479:     } else {
1.269     raeburn  2480:         $sections .= qq|
                   2481: <script type="text/javascript">
1.454     bisitz   2482: // <![CDATA[
1.269     raeburn  2483: function group_or_section(caller) {
                   2484:     return;
                   2485: }
1.454     bisitz   2486: // ]]>
1.269     raeburn  2487: </script>
                   2488: |;
1.446     bisitz   2489:     }
1.299     albertel 2490: 
                   2491:     if (%grouphash) {
1.412     bisitz   2492:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2493:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2494:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2495:         }
                   2496:         $groups .= '>';
1.548     raeburn  2497:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2498:             $groups.='<option value="'.$grp.'" ';
                   2499:             if ($grp eq $cgroup) {
                   2500:                 unless ((defined($uname)) && ($grp eq '')) {
                   2501:                     $groups .=  'selected="selected" ';
                   2502:                 }
                   2503:             } elsif (!defined($cgroup)) {
                   2504:                 if (@{$usersgroups} == 1) {
                   2505:                     if ($grp eq $$usersgroups[0]) {
                   2506:                         $groups .=  'selected="selected" ';
                   2507:                     }
                   2508:                 }
                   2509:             }
                   2510:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2511:         }
                   2512:         $groups.='</select>';
                   2513:     }
1.412     bisitz   2514: 
1.445     neumanie 2515:     if (%sectionhash || %grouphash) {
1.446     bisitz   2516:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2517:         $r->print($sections.$groups);
1.448     bisitz   2518:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2519:     } else {
                   2520:         $r->print($sections); 
1.445     neumanie 2521:     }
1.446     bisitz   2522: 
                   2523:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2524:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2525:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2526:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2527:                  ,$chooseopt));
1.209     www      2528: }
                   2529: 
1.562     damieng  2530: # Prints HTML to select parameters from a list of all parameters.
                   2531: # Uses parmmenu and parmboxes.
                   2532: # Used by table and overview modes.
1.468     amueller 2533: #
1.562     damieng  2534: # @param {Apache2::RequestRec} $r - the Apache request
                   2535: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2536: # @param {array reference} $pscat - list of selected parameter names
                   2537: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2538: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2539: sub displaymenu {
1.581     raeburn  2540:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2541: 
1.445     neumanie 2542:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2543:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2544: 
1.581     raeburn  2545:     &parmmenu($r);
1.536     raeburn  2546:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2547:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2548:     $r->print(&Apache::loncommon::end_scrollbox());
                   2549: 
                   2550:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2551:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2552:  
1.209     www      2553: }
                   2554: 
1.562     damieng  2555: # Prints HTML to select a map.
                   2556: # Used by table mode and overview mode.
                   2557: #
                   2558: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2559: # @param {hash reference} $allmaps - hash map pc -> map src
                   2560: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2561: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2562: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2563: sub mapmenu {
1.499     raeburn  2564:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2565:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2566:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2567:     my $tree=[];
                   2568:     my $treeinfo={};
                   2569:     if (defined($navmap)) {
1.499     raeburn  2570:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2571:         my $curRes;
                   2572:         my $depth = 0;
1.468     amueller 2573:         my %parent = ();
                   2574:         my $startcount = 5;
                   2575:         my $lastcontainer = $startcount;
                   2576: # preparing what is to show ...
1.461     neumanie 2577:         while ($curRes = $it->next()) {
                   2578:             if ($curRes == $it->BEGIN_MAP()) {
                   2579:                 $depth++;
1.468     amueller 2580:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2581:             }
                   2582:             if ($curRes == $it->END_MAP()) {
                   2583:                 $depth--;
1.468     amueller 2584:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2585:             }
                   2586:             if (ref($curRes)) {
1.468     amueller 2587:                 my $symb = $curRes->symb();
                   2588:                 my $ressymb = $symb;
1.461     neumanie 2589:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2590:                     my $type = 'sequence';
                   2591:                     if ($curRes->is_page()) {
                   2592:                         $type = 'page';
                   2593:                     }
                   2594:                     my $id= $curRes->id();
1.468     amueller 2595:                     my $srcf = $curRes->src();
                   2596:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2597:                     if(!exists($treeinfo->{$id})) {
                   2598:                         push(@$tree,$id);
1.473     amueller 2599:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2600:                         $treeinfo->{$id} = {
1.461     neumanie 2601:                                     depth => $depth,
                   2602:                                     type  => $type,
1.468     amueller 2603:                                     name  => $resource_name,
                   2604:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2605:                                     };
1.462     neumanie 2606:                     }
1.461     neumanie 2607:                 }
                   2608:             }
                   2609:         }
1.462     neumanie 2610:     }
1.473     amueller 2611: # Show it ...    
1.484     amueller 2612:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2613:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2614:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2615:         my $whitespace =
                   2616:             '<img src="'
                   2617:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2618:            .'" alt="" />';
                   2619: 
1.498     bisitz   2620:         # Info about selectable folders/maps
                   2621:         $r->print(
                   2622:             '<div class="LC_info">'
1.508     www      2623:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2624:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2625:            .'</div>'
                   2626:         );
                   2627: 
1.536     raeburn  2628:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2629:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2630: 
1.498     bisitz   2631:         # Display row: "All Maps or Folders"
                   2632:         $r->print(
1.523     raeburn  2633:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2634:            .'<td>'
                   2635:            .'<label>'
                   2636:            .'<input type="radio" name="pschp"'
1.497     bisitz   2637:         );
                   2638:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2639:         $r->print(
                   2640:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2641:            .&mt('All Maps or Folders')
                   2642:            .'</label>'
                   2643:            .'<hr /></td>'
                   2644:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2645:         );
1.497     bisitz   2646: 
1.532     raeburn  2647:         # Display row: "Main Content"
1.468     amueller 2648:         if (exists($$allmaps{1})) {
1.498     bisitz   2649:             $r->print(
                   2650:                 &Apache::loncommon::start_data_table_row()
                   2651:                .'<td>'
                   2652:                .'<label>'
                   2653:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2654:             );
1.497     bisitz   2655:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2656:             $r->print(
                   2657:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2658:                .$$maptitles{1}
                   2659:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2660:                .'</label>'
                   2661:                .'</td>'
                   2662:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2663:             );
                   2664:         }
1.497     bisitz   2665: 
                   2666:         # Display rows for all course maps and folders
1.468     amueller 2667:         foreach my $id (@{$tree}) {
                   2668:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2669:             # Indentation
1.468     amueller 2670:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2671:             my $indent;
                   2672:             for (my $i = 0; $i < $depth; $i++) {
                   2673:                 $indent.= $whitespace;
                   2674:             }
1.461     neumanie 2675:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2676:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2677:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2678:             }
1.468     amueller 2679:             my $symb_name = $$symbp{$id};
                   2680:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2681:             $symb_name = $tail;
1.498     bisitz   2682:             $r->print(
                   2683:                 &Apache::loncommon::start_data_table_row()
                   2684:                .'<td>'
                   2685:                .'<label>'
1.463     bisitz   2686:             );
1.498     bisitz   2687:             # Only offer radio button for folders/maps which can be parameterized
                   2688:             if ($allmaps_inverted{$symb_name}) {
                   2689:                 $r->print(
                   2690:                     '<input type ="radio" name="pschp"'
                   2691:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2692:                 );
                   2693:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2694:                 $r->print('/>');
                   2695:             } else {
                   2696:                 $r->print($whitespace);
1.461     neumanie 2697:             }
1.498     bisitz   2698:             $r->print(
                   2699:                 $indent.$icon.'&nbsp;'
                   2700:                .$treeinfo->{$id}->{name}
                   2701:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2702:                .'</label>'
                   2703:                .'</td>'
                   2704:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2705:             );
1.461     neumanie 2706:         }
1.497     bisitz   2707: 
1.523     raeburn  2708:         $r->print(&Apache::loncommon::end_data_table().
                   2709:                   '<br style="line-height:2px;" />'.
                   2710:                   &Apache::loncommon::end_scrollbox());
1.209     www      2711:     }
                   2712: }
                   2713: 
1.563     damieng  2714: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2715: # Used by table and overview modes.
                   2716: #
                   2717: # @param {Apache2::RequestRec} $r - the Apache request
                   2718: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2719: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2720: sub levelmenu {
1.446     bisitz   2721:     my ($r,$alllevs,$parmlev)=@_;
                   2722: 
1.548     raeburn  2723:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2724:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2725:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2726:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2727:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2728:         if ($parmlev eq $$alllevs{$lev}) {
                   2729:             $r->print(' selected="selected"');
                   2730:         }
                   2731:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2732:     }
1.446     bisitz   2733:     $r->print("</select>");
1.208     www      2734: }
                   2735: 
1.211     www      2736: 
1.563     damieng  2737: # Returns HTML to select a section (with a select HTML element).
                   2738: # Used by overview mode.
                   2739: #
                   2740: # @param {array reference} $selectedsections - list of selected section ids
                   2741: # @returns {string}
1.211     www      2742: sub sectionmenu {
1.553     raeburn  2743:     my ($selectedsections)=@_;
1.300     albertel 2744:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2745:     return '' if (!%sectionhash);
1.300     albertel 2746: 
1.552     raeburn  2747:     my (@possibles,$disabled);
                   2748:     if ($env{'request.course.sec'} ne '') {
                   2749:         @possibles = ($env{'request.course.sec'});
                   2750:         $selectedsections = [$env{'request.course.sec'}];
                   2751:         $disabled = ' disabled="disabled"';
                   2752:     } else {
                   2753:         @possibles = ('all',sort(keys(%sectionhash)));
                   2754:     }
1.553     raeburn  2755:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2756:     foreach my $s (@possibles) {
1.553     raeburn  2757:         $output .= '    <option value="'.$s.'"';
                   2758:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2759:             $output .= ' selected="selected"';
1.473     amueller 2760:         }
1.553     raeburn  2761:         $output .= '>'."$s</option>\n";
1.300     albertel 2762:     }
1.553     raeburn  2763:     $output .= "</select>\n";
                   2764:     return $output;
1.269     raeburn  2765: }
                   2766: 
1.563     damieng  2767: # Returns HTML to select a group (with a select HTML element).
                   2768: # Used by overview mode.
                   2769: #
                   2770: # @param {array reference} $selectedgroups - list of selected group names
                   2771: # @returns {string}
1.269     raeburn  2772: sub groupmenu {
1.553     raeburn  2773:     my ($selectedgroups)=@_;
                   2774:     my %grouphash;
                   2775:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2776:         %grouphash = &Apache::longroup::coursegroups();
                   2777:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2778:          map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2779:     }
                   2780:     return '' if (!%grouphash);
1.299     albertel 2781: 
1.553     raeburn  2782:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2783:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2784:         $output .= '    <option value="'.$group.'"';
                   2785:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2786:             $output .=  ' selected="selected"';
1.473     amueller 2787:         }
1.553     raeburn  2788:         $output .= '>'."$group</option>\n";
1.211     www      2789:     }
1.553     raeburn  2790:     $output .= "</select>\n";
                   2791:     return $output;
1.211     www      2792: }
                   2793: 
1.563     damieng  2794: # Returns an array with the given parameter split by comma.
                   2795: # Used by assessparms (table mode).
                   2796: #
                   2797: # @param {string} $keyp - the string to split
                   2798: # @returns {Array<string>}
1.210     www      2799: sub keysplit {
                   2800:     my $keyp=shift;
                   2801:     return (split(/\,/,$keyp));
                   2802: }
                   2803: 
1.563     damieng  2804: # Returns the keys in $name, sorted using $keyorder.
                   2805: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2806: # Used by assessparms (table mode) for resource level.
                   2807: #
                   2808: # @param {hash reference} $name - parameter key -> parameter name
                   2809: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2810: # @returns {Array<string>}
1.210     www      2811: sub keysinorder {
                   2812:     my ($name,$keyorder)=@_;
                   2813:     return sort {
1.560     damieng  2814:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2815:     } (keys(%{$name}));
1.210     www      2816: }
                   2817: 
1.563     damieng  2818: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2819: # Used by assessparms (table mode) for map and general levels.
                   2820: #
                   2821: # @param {hash reference} $name - parameter key -> parameter name
                   2822: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2823: # @returns {Array<string>}
1.236     albertel 2824: sub keysinorder_bytype {
                   2825:     my ($name,$keyorder)=@_;
                   2826:     return sort {
1.563     damieng  2827:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2828:         my $tb=(split('_',$b))[-1];
                   2829:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2830:             return ($a cmp $b);
                   2831:         }
                   2832:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2833:     } (keys(%{$name}));
1.236     albertel 2834: }
                   2835: 
1.563     damieng  2836: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2837: # Used by defaultsetter (parameter settings default actions).
                   2838: #
                   2839: # @param {hash reference} $name - hash parameter name -> parameter title
                   2840: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2841: # @returns {Array<string>}
1.211     www      2842: sub keysindisplayorder {
                   2843:     my ($name,$keyorder)=@_;
                   2844:     return sort {
1.560     damieng  2845:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2846:     } (keys(%{$name}));
1.211     www      2847: }
                   2848: 
1.563     damieng  2849: # Prints HTML with a choice to sort results by realm or student first.
                   2850: # Used by overview mode.
                   2851: #
                   2852: # @param {Apache2::RequestRec} $r - the Apache request
                   2853: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2854: sub sortmenu {
                   2855:     my ($r,$sortorder)=@_;
1.236     albertel 2856:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2857:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2858:        $r->print(' checked="checked"');
1.214     www      2859:     }
                   2860:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2861:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2862:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2863:        $r->print(' checked="checked"');
1.214     www      2864:     }
1.236     albertel 2865:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2866:           '</label>');
1.214     www      2867: }
                   2868: 
1.563     damieng  2869: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2870: #
                   2871: # @returns {hash}
1.211     www      2872: sub standardkeyorder {
                   2873:     return ('parameter_0_opendate' => 1,
1.473     amueller 2874:         'parameter_0_duedate' => 2,
                   2875:         'parameter_0_answerdate' => 3,
                   2876:         'parameter_0_interval' => 4,
                   2877:         'parameter_0_weight' => 5,
                   2878:         'parameter_0_maxtries' => 6,
                   2879:         'parameter_0_hinttries' => 7,
                   2880:         'parameter_0_contentopen' => 8,
                   2881:         'parameter_0_contentclose' => 9,
                   2882:         'parameter_0_type' => 10,
                   2883:         'parameter_0_problemstatus' => 11,
                   2884:         'parameter_0_hiddenresource' => 12,
                   2885:         'parameter_0_hiddenparts' => 13,
                   2886:         'parameter_0_display' => 14,
                   2887:         'parameter_0_ordered' => 15,
                   2888:         'parameter_0_tol' => 16,
                   2889:         'parameter_0_sig' => 17,
                   2890:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2891:         'parameter_0_discussend' => 19,
                   2892:         'parameter_0_discusshide' => 20,
                   2893:         'parameter_0_discussvote' => 21,
1.560     damieng  2894:         'parameter_0_printstartdate'  =>  22,
                   2895:         'parameter_0_printenddate' =>  23);
1.211     www      2896: }
                   2897: 
1.59      matthew  2898: 
1.560     damieng  2899: # Table mode UI.
1.563     damieng  2900: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2901: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2902: #
                   2903: # Parameters used from the request:
                   2904: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2905: # cgroup - selected group
                   2906: # command - 'set': direct access to table mode for a resource
                   2907: # csec - selected section
                   2908: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2909: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2910: # id - student/employee ID
                   2911: # parmlev - selected level (full|map|general)
                   2912: # part - selected part (unused ?)
                   2913: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2914: # pres_type - &&&-separated parameter types
                   2915: # pres_value - &&&-separated parameter values
                   2916: # prevvisit - '1' if the user has submitted the form before
                   2917: # pscat (multiple values) - selected parameter names
1.566     damieng  2918: # pschp - selected map pc, or 'all'
1.563     damieng  2919: # psprt (multiple values) - list of selected parameter parts
                   2920: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2921: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2922: # symb - resource symb (when a single resource is selected)
                   2923: # udom - selected user domain
                   2924: # uname - selected user name
                   2925: # url - used only with command 'set', the resource url
                   2926: #
                   2927: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2928: # @param $parm_permission - ref to hash of permissions
                   2929: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2930: sub assessparms {
1.1       www      2931: 
1.568     raeburn  2932:     my ($r,$parm_permission) = @_;
1.201     www      2933: 
1.512     foxr     2934: 
                   2935: # -------------------------------------------------------- Variable declaration
1.566     damieng  2936:     my @ids=(); # resource and map ids
                   2937:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2938:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2939:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2940:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2941:     my %uris=(); # hash resource/map id -> resource src
                   2942:     my %maptitles=(); # hash map pc or src -> map title
                   2943:     my %allmaps=(); # hash map pc -> map src
1.582     raeburn  2944:     my %allmaps_inverted=(); # hash map src -> map pc
1.563     damieng  2945:     my %alllevs=(); # hash English level title -> value
                   2946: 
                   2947:     my $uname; # selected user name
                   2948:     my $udom; # selected user domain
                   2949:     my $uhome; # server with the user's files, or 'no_host'
                   2950:     my $csec; # selected section name
                   2951:     my $cgroup; # selected group name
                   2952:     my @usersgroups = (); # list of the user groups
1.582     raeburn  2953:     my $numreclinks = 0;
1.446     bisitz   2954: 
1.190     albertel 2955:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2956: 
1.57      albertel 2957:     $alllevs{'Resource Level'}='full';
1.215     www      2958:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2959:     $alllevs{'Course Level'}='general';
                   2960: 
1.563     damieng  2961:     my %allparms; # hash parameter name -> parameter title
                   2962:     my %allparts; # hash parameter part -> part title
1.512     foxr     2963: # ------------------------------------------------------------------------------
                   2964: 
1.210     www      2965: #
                   2966: # Order in which these parameters will be displayed
                   2967: #
1.211     www      2968:     my %keyorder=&standardkeyorder();
                   2969: 
1.512     foxr     2970: #    @ids=();
                   2971: #    %symbp=();       # These seem defined above already.
                   2972: #    %typep=();
1.43      albertel 2973: 
                   2974:     my $message='';
                   2975: 
1.190     albertel 2976:     $csec=$env{'form.csec'};
1.552     raeburn  2977:     if ($env{'request.course.sec'} ne '') {
                   2978:         $csec = $env{'request.course.sec'};    
                   2979:     }
                   2980: 
1.553     raeburn  2981: # Check group privs.
1.269     raeburn  2982:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2983:     my $noeditgrp; 
                   2984:     if ($cgroup ne '') {
                   2985:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2986:             if (($env{'request.course.groups'} eq '') || 
1.585     raeburn  2987:                 (!grep(/^\Q$cgroup\E$/,split(/:/,$env{'request.course.groups'})))) {
1.553     raeburn  2988:                 $noeditgrp = 1;
                   2989:             }
                   2990:         }
                   2991:     }
1.188     www      2992: 
1.190     albertel 2993:     if      ($udom=$env{'form.udom'}) {
                   2994:     } elsif ($udom=$env{'request.role.domain'}) {
                   2995:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2996:     } else {
1.473     amueller 2997:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2998:     }
1.468     amueller 2999:     
1.43      albertel 3000: 
1.134     albertel 3001:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 3002:     my $pschp=$env{'form.pschp'};
1.506     www      3003: 
                   3004: 
1.134     albertel 3005:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      3006:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      3007:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 3008: 
1.43      albertel 3009:     my $pssymb='';
1.57      albertel 3010:     my $parmlev='';
1.446     bisitz   3011: 
1.190     albertel 3012:     unless ($env{'form.parmlev'}) {
1.57      albertel 3013:         $parmlev = 'map';
                   3014:     } else {
1.190     albertel 3015:         $parmlev = $env{'form.parmlev'};
1.57      albertel 3016:     }
1.26      www      3017: 
1.29      www      3018: # ----------------------------------------------- Was this started from grades?
                   3019: 
1.560     damieng  3020:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   3021:             (!$env{'form.dis'})) {
1.473     amueller 3022:         my $url=$env{'form.url'};
                   3023:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   3024:         $pssymb=&Apache::lonnet::symbread($url);
                   3025:         if (!@pscat) { @pscat=('all'); }
                   3026:         $pschp='';
1.57      albertel 3027:         $parmlev = 'full';
1.190     albertel 3028:     } elsif ($env{'form.symb'}) {
1.473     amueller 3029:         $pssymb=$env{'form.symb'};
                   3030:         if (!@pscat) { @pscat=('all'); }
                   3031:         $pschp='';
1.57      albertel 3032:         $parmlev = 'full';
1.43      albertel 3033:     } else {
1.473     amueller 3034:         $env{'form.url'}='';
1.43      albertel 3035:     }
                   3036: 
1.190     albertel 3037:     my $id=$env{'form.id'};
1.43      albertel 3038:     if (($id) && ($udom)) {
1.555     raeburn  3039:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 3040:         if ($uname) {
                   3041:             $id='';
                   3042:         } else {
                   3043:             $message=
1.540     bisitz   3044:                 '<p class="LC_warning">'.
                   3045:                 &mt('Unknown ID [_1] at domain [_2]',
                   3046:                     "'".$id."'","'".$udom."'").
                   3047:                 '</p>';
1.473     amueller 3048:         }
1.43      albertel 3049:     } else {
1.473     amueller 3050:         $uname=$env{'form.uname'};
1.43      albertel 3051:     }
                   3052:     unless ($udom) { $uname=''; }
                   3053:     $uhome='';
                   3054:     if ($uname) {
1.473     amueller 3055:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 3056:         if ($uhome eq 'no_host') {
1.473     amueller 3057:             $message=
1.540     bisitz   3058:                 '<p class="LC_warning">'.
                   3059:                 &mt('Unknown user [_1] at domain [_2]',
                   3060:                     "'".$uname."'","'".$udom."'").
                   3061:                 '</p>';
1.473     amueller 3062:             $uname='';
1.12      www      3063:         } else {
1.473     amueller 3064:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   3065:                           $env{'request.course.id'});
                   3066:             if ($csec eq '-1') {
1.540     bisitz   3067:                 $message=
                   3068:                     '<p class="LC_warning">'.
                   3069:                     &mt('User [_1] at domain [_2] not in this course',
                   3070:                         "'".$uname."'","'".$udom."'").
                   3071:                     '</p>';
1.473     amueller 3072:                 $uname='';
                   3073:                 $csec=$env{'form.csec'};
1.269     raeburn  3074:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 3075:             } else {
                   3076:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   3077:                   ('firstname','middlename','lastname','generation','id'));
                   3078:                 $message="\n<p>\n".&mt("Full Name").": ".
                   3079:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   3080:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   3081:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 3082:             }
1.297     raeburn  3083:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  3084:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  3085:             if (@usersgroups > 0) {
1.306     albertel 3086:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  3087:                     $cgroup = $usersgroups[0];
1.297     raeburn  3088:                 }
1.269     raeburn  3089:             }
1.12      www      3090:         }
1.43      albertel 3091:     }
1.2       www      3092: 
1.43      albertel 3093:     unless ($csec) { $csec=''; }
1.269     raeburn  3094:     unless ($cgroup) { $cgroup=''; }
1.12      www      3095: 
1.14      www      3096: # --------------------------------------------------------- Get all assessments
1.446     bisitz   3097:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3098:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3099:                 \%keyorder);
1.63      bowersj2 3100: 
1.582     raeburn  3101:     %allmaps_inverted = reverse(%allmaps);
                   3102: 
1.57      albertel 3103:     $mapp{'0.0'} = '';
                   3104:     $symbp{'0.0'} = '';
1.99      albertel 3105: 
1.14      www      3106: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  3107:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      3108:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   3109:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   3110:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  3111:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3112:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  3113:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   3114:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   3115:         my $totalstored = 0;
1.546     raeburn  3116:         my $now = time;
1.473     amueller 3117:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  3118:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  3119:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  3120:                 next if ($csec ne $env{'request.course.sec'});
                   3121:             }
1.556     raeburn  3122:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  3123:                 next if ($noeditgrp);
1.557     raeburn  3124:             }
                   3125:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   3126:                 $namematch = 'maplevelrecurse';
                   3127:             }
1.556     raeburn  3128:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  3129:                 my (@ok_slots,@fail_slots,@del_slots);
                   3130:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   3131:                 my ($level,@all) =
                   3132:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   3133:                                      $csec,$cgroup,$courseopt);
                   3134:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   3135:                     next if ($slot_name eq '');
                   3136:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   3137:                         push(@ok_slots,$slot_name);
                   3138: 
                   3139:                     } else {
                   3140:                         push(@fail_slots,$slot_name);
                   3141:                     }
                   3142:                 }
                   3143:                 if (@ok_slots) {
                   3144:                     $values[$i] = join(':',@ok_slots);
                   3145:                 } else {
                   3146:                     $values[$i] = '';
                   3147:                 }
                   3148:                 if ($all[$level] ne '') {
                   3149:                     my @existing = split(/:/,$all[$level]);
                   3150:                     foreach my $slot_name (@existing) {
                   3151:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   3152:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   3153:                                 push(@del_slots,$slot_name);
                   3154:                             }
                   3155:                         }
                   3156:                     }
                   3157:                 }
1.554     raeburn  3158:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  3159:                 $name = $1;
1.533     raeburn  3160:                 my $val = $values[$i];
1.549     raeburn  3161:                 my $valmatch = '';
1.533     raeburn  3162:                 if ($name eq 'examcode') {
1.544     raeburn  3163:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   3164:                         $val = 'valid';
                   3165:                     }
1.546     raeburn  3166:                 } elsif ($name eq 'printstartdate') {
                   3167:                     if ($val =~ /^\d+$/) {
                   3168:                         if ($val > $now) {
                   3169:                             $val = 'future';
                   3170:                         }
                   3171:                     } 
                   3172:                 } elsif ($name eq 'printenddate') {
                   3173:                     if ($val =~ /^\d+$/) {
                   3174:                         if ($val < $now) {
                   3175:                             $val = 'past';
                   3176:                         }
                   3177:                     }
1.549     raeburn  3178:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   3179:                     my $stringtype = &get_stringtype($name);
                   3180:                     my $stringmatch = &standard_string_matches($stringtype);
                   3181:                     if (ref($stringmatch) eq 'ARRAY') {
                   3182:                         foreach my $item (@{$stringmatch}) {
                   3183:                             if (ref($item) eq 'ARRAY') {
                   3184:                                 my ($regexpname,$pattern) = @{$item};
                   3185:                                 if ($pattern ne '') {
                   3186:                                     if ($val =~ /$pattern/) {
                   3187:                                         $valmatch = $regexpname;
                   3188:                                         $val = '';
                   3189:                                         last;
                   3190:                                     }
                   3191:                                 }
                   3192:                             }
                   3193:                         }
                   3194:                     }
1.554     raeburn  3195:                 } elsif ($name eq 'interval') {
                   3196:                     my $intervaltype = &get_intervaltype($name);
                   3197:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   3198:                     if (ref($intervalmatch) eq 'ARRAY') {
                   3199:                         foreach my $item (@{$intervalmatch}) {
                   3200:                             if (ref($item) eq 'ARRAY') {
                   3201:                                 my ($regexpname,$pattern) = @{$item};
                   3202:                                 if ($pattern ne '') {
                   3203:                                     if ($val =~ /$pattern/) {
                   3204:                                         $valmatch = $regexpname;
                   3205:                                         $val = '';
                   3206:                                         last;
                   3207:                                     }
                   3208:                                 }
                   3209:                             }
                   3210:                         }
                   3211:                     }
1.533     raeburn  3212:                 }
1.504     raeburn  3213:                 $needsrelease =
1.557     raeburn  3214:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  3215:                 if ($needsrelease) {
1.505     raeburn  3216:                     unless ($got_chostname) {
1.514     raeburn  3217:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  3218:                         $got_chostname = 1;
1.546     raeburn  3219:                     } 
1.557     raeburn  3220:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  3221:                                                           $needsrelease,
                   3222:                                                           $cmajor,$cminor);
1.500     raeburn  3223:                 }
1.437     raeburn  3224:             }
1.504     raeburn  3225:             if ($needsnewer) {
1.557     raeburn  3226:                 undef($namematch);
                   3227:             } else {
                   3228:                 my $currneeded;
                   3229:                 if ($needsrelease) {
                   3230:                     $currneeded = $needsrelease;
                   3231:                 }
                   3232:                 if ($namematch) {
                   3233:                     $needsrelease =
                   3234:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3235:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3236:                         unless ($got_chostname) {
                   3237:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3238:                             $got_chostname = 1;
                   3239:                         }
                   3240:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3241:                                                               $needsrelease,
                   3242:                                                               $cmajor,$cminor);
                   3243:                     } else {
                   3244:                         undef($namematch);
                   3245:                     }
                   3246:                 }
                   3247:             }
                   3248:             if ($needsnewer) {
                   3249:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3250:                                                 $cminor,$needsrelease);
                   3251:             } else {
                   3252:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3253:                                      $values[$i],
                   3254:                                      $types[$i],
                   3255:                                      $uname,$udom,$csec,$cgroup);
                   3256:                 $totalstored ++;
                   3257:             }
1.473     amueller 3258:         }
1.68      www      3259: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3260:         if ($totalstored) {
                   3261:             $message.='<p class="LC_warning">'
                   3262:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3263:                      .&Apache::loncommon::help_open_topic('Caching')
                   3264:                      .'</p>';
                   3265:         }
1.68      www      3266:     }
1.584     raeburn  3267: 
1.57      albertel 3268: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3269:     if ($pscat[0] eq "all") {
                   3270:         @pscat = (keys(%allparms));
                   3271:     }
                   3272:     if (!@pscat) {
                   3273:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3274:     };
                   3275:     if ($psprt[0] eq "all" || !@psprt) {
                   3276:         @psprt = (keys(%allparts));
                   3277:     }
1.2       www      3278: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3279: 
1.531     raeburn  3280:     my $crstype = &Apache::loncommon::course_type();
                   3281:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3282: 
1.548     raeburn  3283:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.589     raeburn  3284:             'date_interval','int','float','string','string_lenient',
                   3285:             'string_examcode','string_deeplink','string_discussvote',
                   3286:             'string_useslots','string_problemstatus','string_ip',
                   3287:             'string_questiontype') {
1.473     amueller 3288:         $r->print('<input type="hidden" value="'.
1.563     damieng  3289:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3290:             '" name="recent_'.$item.'" />');
1.44      albertel 3291:     }
1.446     bisitz   3292: 
1.459     bisitz   3293:     # ----- Start Parameter Selection
                   3294: 
                   3295:     # Hide parm selection?
                   3296:     $r->print(<<ENDPARMSELSCRIPT);
                   3297: <script type="text/javascript">
                   3298: // <![CDATA[
                   3299: function parmsel_show() {
1.562     damieng  3300:     document.getElementById('parmsel').style.display = "";
                   3301:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3302: }
                   3303: // ]]>
                   3304: </script>
                   3305: ENDPARMSELSCRIPT
1.474     amueller 3306:     
1.445     neumanie 3307:     if (!$pssymb) {
1.563     damieng  3308:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3309:         my $parmselhiddenstyle=' style="display:none"';
                   3310:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3311:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3312:         } else  {
                   3313:            $r->print('<div id="parmsel">');
                   3314:         }
                   3315: 
1.491     bisitz   3316:         # Step 1
1.523     raeburn  3317:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3318:         $r->print('
1.474     amueller 3319: <script type="text/javascript">
1.523     raeburn  3320: // <![CDATA['.
                   3321:                  &showhide_js().'
1.474     amueller 3322: // ]]>
                   3323: </script>
1.523     raeburn  3324: ');
                   3325:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3326:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3327:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3328:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3329:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3330:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3331:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3332:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3333:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3334: 
                   3335:         # Step 2
1.523     raeburn  3336:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581     raeburn  3337:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3338: 
                   3339:         # Step 3
1.523     raeburn  3340:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3341:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3342:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3343:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3344:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3345: 
                   3346:         # Update Display Button
1.486     www      3347:         $r->print('<p>'
                   3348:              .'<input type="submit" name="dis"'
1.511     www      3349:              .' value="'.&mt('Update Display').'" />'
1.486     www      3350:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3351:              .'</p>');
                   3352:         $r->print('</div>');
1.491     bisitz   3353: 
1.486     www      3354:         # Offer link to display parameter selection again
                   3355:         $r->print('<p id="parmsellink"');
                   3356:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3357:            $r->print($parmselhiddenstyle);
                   3358:         }
                   3359:         $r->print('>'
                   3360:              .'<a href="javascript:parmsel_show()">'
                   3361:              .&mt('Change Parameter Selection')
                   3362:              .'</a>'
                   3363:              .'</p>');
1.44      albertel 3364:     } else {
1.478     amueller 3365:         # parameter screen for a single resource. 
1.486     www      3366:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3367:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3368:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3369:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3370:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3371:                   '<br />');
                   3372:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3373:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3374:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3375:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3376:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3377:         $r->print('<p>'
1.459     bisitz   3378:              .'<input type="submit" name="dis"'
1.511     www      3379:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3380:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3381:              .'</p>');
1.459     bisitz   3382:     }
1.478     amueller 3383:     
1.486     www      3384:     # ----- End Parameter Selection
1.57      albertel 3385: 
1.459     bisitz   3386:     # Display Messages
                   3387:     $r->print('<div>'.$message.'</div>');
1.210     www      3388: 
1.57      albertel 3389: 
                   3390:     my @temp_pscat;
                   3391:     map {
                   3392:         my $cat = $_;
                   3393:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3394:     } @pscat;
                   3395: 
                   3396:     @pscat = @temp_pscat;
                   3397: 
1.548     raeburn  3398: 
1.209     www      3399:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3400: # ----------------------------------------------------------------- Start Table
1.57      albertel 3401:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3402:         my $csuname=$env{'user.name'};
                   3403:         my $csudom=$env{'user.domain'};
1.568     raeburn  3404:         my $readonly = 1;
                   3405:         if ($parm_permission->{'edit'}) {
                   3406:             undef($readonly); 
                   3407:         }
1.57      albertel 3408: 
1.203     www      3409:         if ($parmlev eq 'full') {
1.506     www      3410: #
                   3411: # This produces the cascading table output of parameters
                   3412: #
1.578     raeburn  3413:             my $coursespan=$csec?8:5;
                   3414:             my $userspan=3;
1.560     damieng  3415:             if ($cgroup ne '') {
1.578     raeburn  3416:                 $coursespan += 3;
1.560     damieng  3417:             }
1.473     amueller 3418: 
1.560     damieng  3419:             $r->print(&Apache::loncommon::start_data_table());
                   3420:             #
                   3421:             # This produces the headers
                   3422:             #
                   3423:             $r->print('<tr><td colspan="5"></td>');
                   3424:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3425:             if ($uname) {
1.473     amueller 3426:                 if (@usersgroups > 1) {
1.560     damieng  3427:                     $userspan ++;
                   3428:                 }
                   3429:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3430:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3431:             }
                   3432:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3433:                 'pie'    => "Parameter in Effect",
                   3434:                 'csv'    => "Current Session Value",
1.472     amueller 3435:                 'rl'     => "Resource Level",
1.473     amueller 3436:                 'ic'     => 'in Course',
                   3437:                 'aut'    => "Assessment URL and Title",
                   3438:                 'type'   => 'Type',
                   3439:                 'emof'   => "Enclosing Map or Folder",
                   3440:                 'part'   => 'Part',
1.472     amueller 3441:                 'pn'     => 'Parameter Name',
1.473     amueller 3442:                 'def'    => 'default',
                   3443:                 'femof'  => 'from Enclosing Map or Folder',
                   3444:                 'gen'    => 'general',
                   3445:                 'foremf' => 'for Enclosing Map or Folder',
                   3446:                 'fr'     => 'for Resource'
                   3447:             );
1.560     damieng  3448:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3449: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3450: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3451: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3452: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3453: 
1.10      www      3454: ENDTABLETWO
1.560     damieng  3455:             if ($csec) {
1.578     raeburn  3456:                 $r->print('<th colspan="3">'.
1.560     damieng  3457:                 &mt("in Section")." $csec</th>");
                   3458:             }
                   3459:             if ($cgroup) {
1.578     raeburn  3460:                 $r->print('<th colspan="3">'.
1.472     amueller 3461:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3462:             }
                   3463:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3464: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3465: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3466: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3467: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3468: ENDTABLEHEADFOUR
1.57      albertel 3469: 
1.560     damieng  3470:             if ($csec) {
1.578     raeburn  3471:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3472:             }
1.473     amueller 3473: 
1.560     damieng  3474:             if ($cgroup) {
1.578     raeburn  3475:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3476:             }
                   3477: 
                   3478:             if ($uname) {
                   3479:                 if (@usersgroups > 1) {
                   3480:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3481:                 }
1.578     raeburn  3482:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3483:             }
                   3484: 
                   3485:             $r->print('</tr>');
1.506     www      3486: #
                   3487: # Done with the headers
                   3488: # 
1.560     damieng  3489:             my $defbgone='';
                   3490:             my $defbgtwo='';
                   3491:             my $defbgthree = '';
1.57      albertel 3492: 
1.560     damieng  3493:             foreach my $rid (@ids) {
1.57      albertel 3494: 
                   3495:                 my ($inmapid)=($rid=~/\.(\d+)$/);
1.446     bisitz   3496:                 if ((!$pssymb &&
1.560     damieng  3497:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3498:                         ||
                   3499:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3500: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3501:                     if ($defbgone eq '#E0E099') {
                   3502:                         $defbgone='#E0E0DD';
1.57      albertel 3503:                     } else {
1.419     bisitz   3504:                         $defbgone='#E0E099';
1.57      albertel 3505:                     }
1.419     bisitz   3506:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3507:                         $defbgtwo='#FFFFDD';
1.57      albertel 3508:                     } else {
1.473     amueller 3509:                         $defbgtwo='#FFFF99';
1.57      albertel 3510:                     }
1.419     bisitz   3511:                     if ($defbgthree eq '#FFBB99') {
                   3512:                         $defbgthree='#FFBBDD';
1.269     raeburn  3513:                     } else {
1.419     bisitz   3514:                         $defbgthree='#FFBB99';
1.269     raeburn  3515:                     }
                   3516: 
1.57      albertel 3517:                     my $thistitle='';
                   3518:                     my %name=   ();
                   3519:                     undef %name;
                   3520:                     my %part=   ();
                   3521:                     my %display=();
                   3522:                     my %type=   ();
                   3523:                     my %default=();
1.196     www      3524:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3525:                     my $toolsymb;
                   3526:                     if ($uri =~ /ext\.tool$/) {
                   3527:                         $toolsymb = $symbp{$rid};
                   3528:                     }
1.57      albertel 3529: 
1.506     www      3530:                     my $filter=$env{'form.filter'};
1.548     raeburn  3531:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3532:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.584     raeburn  3533:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name',$toolsymb);
1.560     damieng  3534:     # We may only want certain parameters listed
                   3535:                             if ($filter) {
                   3536:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3537:                             }
                   3538:                             $name{$tempkeyp}=$parmname;
1.584     raeburn  3539:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part',$toolsymb);
1.560     damieng  3540: 
1.584     raeburn  3541:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display',$toolsymb);
1.560     damieng  3542:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3543:                                 my $identifier;
                   3544:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3545:                                     $identifier = $1;
                   3546:                                 }
                   3547:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3548:                             } else {
                   3549:                                 $display{$tempkeyp} = $parmdis;
                   3550:                             }
                   3551:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3552:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.584     raeburn  3553:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp,$toolsymb);
                   3554:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type',$toolsymb);
                   3555:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title',$toolsymb);
1.57      albertel 3556:                         }
                   3557:                     }
1.548     raeburn  3558:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3559:                     if ($totalparms>0) {
1.560     damieng  3560:                         my $firstrow=1;
1.473     amueller 3561:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.582     raeburn  3562:                         my $navmap = Apache::lonnavmaps::navmap->new();
                   3563:                         my @recurseup;
                   3564:                         if (ref($navmap) && $mapp{$rid}) {
                   3565:                             @recurseup = $navmap->recurseup_maps($mapp{$rid});
                   3566:                         }
1.419     bisitz   3567:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3568:                              ' rowspan='.$totalparms.
1.419     bisitz   3569:                              '><tt><font size="-1">'.
1.57      albertel 3570:                              join(' / ',split(/\//,$uri)).
                   3571:                              '</font></tt><p><b>'.
1.154     albertel 3572:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3573:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3574:                           &escape($symbp{$rid}).
1.336     albertel 3575:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3576:                              " target=\"_self\">$title");
1.57      albertel 3577: 
                   3578:                         if ($thistitle) {
1.473     amueller 3579:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3580:                         }
                   3581:                         $r->print('</a></b></td>');
1.419     bisitz   3582:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3583:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3584:                                       '</td>');
                   3585: 
1.419     bisitz   3586:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3587:                                       ' rowspan='.$totalparms.
1.238     www      3588:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3589:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3590:                             unless ($firstrow) {
                   3591:                                 $r->print('<tr>');
                   3592:                             } else {
                   3593:                                 undef $firstrow;
                   3594:                             }
1.548     raeburn  3595:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3596:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3597:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.582     raeburn  3598:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly,
                   3599:                                        \@recurseup,\%maptitles,\%allmaps_inverted,
                   3600:                                        \$numreclinks);
1.57      albertel 3601:                         }
                   3602:                     }
                   3603:                 }
                   3604:             } # end foreach ids
1.43      albertel 3605: # -------------------------------------------------- End entry for one resource
1.517     www      3606:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3607:         } # end of  full
1.57      albertel 3608: #--------------------------------------------------- Entry for parm level map
                   3609:         if ($parmlev eq 'map') {
1.419     bisitz   3610:             my $defbgone = '#E0E099';
                   3611:             my $defbgtwo = '#FFFF99';
                   3612:             my $defbgthree = '#FFBB99';
1.57      albertel 3613: 
                   3614:             my %maplist;
                   3615: 
                   3616:             if ($pschp eq 'all') {
1.446     bisitz   3617:                 %maplist = %allmaps;
1.57      albertel 3618:             } else {
                   3619:                 %maplist = ($pschp => $mapp{$pschp});
                   3620:             }
                   3621: 
                   3622: #-------------------------------------------- for each map, gather information
                   3623:             my $mapid;
1.560     damieng  3624:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3625:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3626: 
                   3627: #-----------------------  loop through ids and get all parameter types for map
                   3628: #-----------------------------------------          and associated information
                   3629:                 my %name = ();
                   3630:                 my %part = ();
                   3631:                 my %display = ();
                   3632:                 my %type = ();
                   3633:                 my %default = ();
                   3634:                 my $map = 0;
                   3635: 
1.473     amueller 3636: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3637: 
1.548     raeburn  3638:                 foreach my $id (@ids) {
                   3639:                     ($map)=($id =~ /([\d]*?)\./);
                   3640:                     my $rid = $id;
1.446     bisitz   3641: 
1.57      albertel 3642: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3643: 
1.560     damieng  3644:                     if ($map eq $mapid) {
1.473     amueller 3645:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3646:                         my $toolsymb;
                   3647:                         if ($uri =~ /ext\.tool$/) {
                   3648:                             $toolsymb = $symbp{$rid};
                   3649:                         }
1.582     raeburn  3650: 
1.57      albertel 3651: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3652: 
                   3653: #--------------------------------------------------------------------
                   3654: # @catmarker contains list of all possible parameters including part #s
                   3655: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3656: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3657: # When storing information, store as part 0
                   3658: # When requesting information, request from full part
                   3659: #-------------------------------------------------------------------
1.548     raeburn  3660:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3661:                             my $tempkeyp = $fullkeyp;
                   3662:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3663: 
1.548     raeburn  3664:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3665:                                 $part{$tempkeyp}="0";
1.584     raeburn  3666:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3667:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3668:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3669:                                     my $identifier;
                   3670:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3671:                                         $identifier = $1;
                   3672:                                     }
                   3673:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3674:                                 } else {
                   3675:                                     $display{$tempkeyp} = $parmdis;
                   3676:                                 }
                   3677:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3678:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3679:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3680:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3681:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.473     amueller 3682:                               }
                   3683:                         } # end loop through keys
1.560     damieng  3684:                     }
1.57      albertel 3685:                 } # end loop through ids
1.446     bisitz   3686: 
1.57      albertel 3687: #---------------------------------------------------- print header information
1.133     www      3688:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3689:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3690:                 my $tmp="";
1.57      albertel 3691:                 if ($uname) {
1.473     amueller 3692:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3693:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3694:                         &mt('in')." \n";
1.57      albertel 3695:                 } else {
1.401     bisitz   3696:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3697:                 }
1.269     raeburn  3698:                 if ($cgroup) {
1.401     bisitz   3699:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3700:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3701:                     $csec = '';
                   3702:                 } elsif ($csec) {
1.401     bisitz   3703:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3704:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3705:                 }
1.401     bisitz   3706:                 $r->print('<div align="center"><h4>'
                   3707:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3708:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3709:                              ,$tmp
                   3710:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3711:                              )
                   3712:                          ."<br /></h4>\n"
1.422     bisitz   3713:                 );
1.57      albertel 3714: #---------------------------------------------------------------- print table
1.419     bisitz   3715:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3716:                          .&Apache::loncommon::start_data_table_header_row()
                   3717:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3718:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3719:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3720:                          .&Apache::loncommon::end_data_table_header_row()
                   3721:                 );
1.57      albertel 3722: 
1.582     raeburn  3723:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   3724:                 my @recurseup;
                   3725:                 if (ref($navmap)) {
                   3726:                      my $mapres = $navmap->getByMapPc($mapid);
                   3727:                      if (ref($mapres)) {
                   3728:                          @recurseup = $navmap->recurseup_maps($mapres->src());
                   3729:                      }
                   3730:                 }
                   3731: 
                   3732: 
1.548     raeburn  3733:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3734:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3735:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3736:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3737:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
1.582     raeburn  3738:                            $readonly,\@recurseup,\%maptitles,\%allmaps_inverted,
                   3739:                            \$numreclinks);
1.57      albertel 3740:                 }
1.422     bisitz   3741:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3742:                          .'</div>'
                   3743:                 );
1.57      albertel 3744:             } # end each map
                   3745:         } # end of $parmlev eq map
                   3746: #--------------------------------- Entry for parm level general (Course level)
                   3747:         if ($parmlev eq 'general') {
1.473     amueller 3748:             my $defbgone = '#E0E099';
1.419     bisitz   3749:             my $defbgtwo = '#FFFF99';
                   3750:             my $defbgthree = '#FFBB99';
1.57      albertel 3751: 
                   3752: #-------------------------------------------- for each map, gather information
                   3753:             my $mapid="0.0";
                   3754: #-----------------------  loop through ids and get all parameter types for map
                   3755: #-----------------------------------------          and associated information
                   3756:             my %name = ();
                   3757:             my %part = ();
                   3758:             my %display = ();
                   3759:             my %type = ();
                   3760:             my %default = ();
1.446     bisitz   3761: 
1.548     raeburn  3762:             foreach $id (@ids) {
                   3763:                 my $rid = $id;
1.446     bisitz   3764: 
1.196     www      3765:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3766:                 my $toolsymb;
                   3767:                 if ($uri =~ /ext\.tool$/) {
                   3768:                     $toolsymb = $symbp{$rid};
                   3769:                 }
1.57      albertel 3770: 
                   3771: #--------------------------------------------------------------------
                   3772: # @catmarker contains list of all possible parameters including part #s
                   3773: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3774: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3775: # When storing information, store as part 0
                   3776: # When requesting information, request from full part
                   3777: #-------------------------------------------------------------------
1.548     raeburn  3778:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3779:                     my $tempkeyp = $fullkeyp;
                   3780:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3781:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3782:                         $part{$tempkeyp}="0";
1.584     raeburn  3783:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3784:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3785:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3786:                             my $identifier;
                   3787:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3788:                                 $identifier = $1;
                   3789:                             }
                   3790:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3791:                         } else {
                   3792:                             $display{$tempkeyp} = $parmdis;
                   3793:                         }
                   3794:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3795:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3796:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3797:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3798:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.560     damieng  3799:                     }
1.57      albertel 3800:                 } # end loop through keys
                   3801:             } # end loop through ids
1.446     bisitz   3802: 
1.57      albertel 3803: #---------------------------------------------------- print header information
1.473     amueller 3804:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3805:             $r->print(<<ENDMAPONE);
1.419     bisitz   3806: <center>
                   3807: <h4>$setdef
1.135     albertel 3808: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3809: ENDMAPONE
                   3810:             if ($uname) {
1.473     amueller 3811:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3812:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3813:             } else {
1.135     albertel 3814:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3815:             }
1.446     bisitz   3816: 
1.135     albertel 3817:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3818:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3819:             $r->print("</h4>\n");
1.57      albertel 3820: #---------------------------------------------------------------- print table
1.419     bisitz   3821:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3822:                      .&Apache::loncommon::start_data_table_header_row()
                   3823:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3824:                      .'<th>'.&mt('Default Value').'</th>'
                   3825:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3826:                      .&Apache::loncommon::end_data_table_header_row()
                   3827:             );
1.57      albertel 3828: 
1.548     raeburn  3829:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3830:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3831:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3832:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3833:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3834:                            $readonly);
1.57      albertel 3835:             }
1.419     bisitz   3836:             $r->print(&Apache::loncommon::end_data_table()
                   3837:                      .'</p>'
                   3838:                      .'</center>'
                   3839:             );
1.57      albertel 3840:         } # end of $parmlev eq general
1.43      albertel 3841:     }
1.507     www      3842:     $r->print('</form>');
1.582     raeburn  3843:     if ($numreclinks) {
                   3844:         $r->print(<<"END");
                   3845: <form name="recurseform" action="/adm/parmset?action=settable" method="post">
                   3846: <input type="hidden" name="pschp" />
                   3847: <input type="hidden" name="pscat" />
                   3848: <input type="hidden" name="psprt" />
                   3849: <input type="hidden" name="hideparmsel" value="hidden" />
                   3850: </form>
                   3851: <script type="text/javascript">
                   3852: function pjumprec(rid,name,part) {
                   3853:     document.forms.recurseform.pschp.value = rid;
                   3854:     document.forms.recurseform.pscat.value = name;
                   3855:     document.forms.recurseform.psprt.value = part;
                   3856:     document.forms.recurseform.submit();
                   3857:     return false;
                   3858: }
                   3859: </script>
                   3860: END
                   3861:     }
1.507     www      3862:     &endSettingsScreen($r);
                   3863:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3864: } # end sub assessparms
1.30      www      3865: 
1.560     damieng  3866: 
                   3867: 
1.120     www      3868: ##################################################
1.560     damieng  3869: # OVERVIEW MODE
1.207     www      3870: ##################################################
1.124     www      3871: 
1.563     damieng  3872: my $tableopen; # boolean, true if HTML table is already opened
                   3873: 
                   3874: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3875: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3876: # @returns {string}
1.124     www      3877: sub tablestart {
1.576     raeburn  3878:     my ($readonly,$is_map) = @_;
1.124     www      3879:     if ($tableopen) {
1.552     raeburn  3880:         return '';
1.124     www      3881:     } else {
1.552     raeburn  3882:         $tableopen=1;
                   3883:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3884:         if ($readonly) {
                   3885:             $output .= '<th>'.&mt('Current value').'</th>';
                   3886:         } else {
1.576     raeburn  3887:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3888:                        '<th>'.&mt('Set to ...').'</th>';
                   3889:             if ($is_map) {
                   3890:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3891:             }
1.552     raeburn  3892:         }
                   3893:         $output .= '</tr>';
                   3894:         return $output;
1.124     www      3895:     }
                   3896: }
                   3897: 
1.563     damieng  3898: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3899: # @returns {string}
1.124     www      3900: sub tableend {
                   3901:     if ($tableopen) {
1.560     damieng  3902:         $tableopen=0;
                   3903:         return &Apache::loncommon::end_data_table();
1.124     www      3904:     } else {
1.560     damieng  3905:         return'';
1.124     www      3906:     }
                   3907: }
                   3908: 
1.563     damieng  3909: # Reads course and user information.
                   3910: # 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).
                   3911: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3912: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3913: # @param {string} $crs - course number
                   3914: # @param {string} $dom - course domain
                   3915: # @returns {hash reference|Array}
1.207     www      3916: sub readdata {
                   3917:     my ($crs,$dom)=@_;
                   3918: # Read coursedata
                   3919:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3920: # Read userdata
                   3921: 
                   3922:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3923:     foreach my $user (keys(%$classlist)) {
                   3924:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3925:             my ($tuname,$tudom)=($1,$2);
                   3926:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3927:             foreach my $userkey (keys(%{$useropt})) {
                   3928:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3929:                     my $newkey=$userkey;
1.548     raeburn  3930:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3931:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3932:                 }
                   3933:             }
1.473     amueller 3934:         }
                   3935:     }
1.552     raeburn  3936:     if (wantarray) {
                   3937:         return ($resourcedata,$classlist);
                   3938:     } else {
                   3939:         return $resourcedata;
                   3940:     }
1.207     www      3941: }
                   3942: 
                   3943: 
1.563     damieng  3944: # Stores parameter data, using form parameters directly.
                   3945: #
                   3946: # 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  3947: # set_* (except settext, setipallow, setipdeny, setdeeplink) - set a parameter value
1.563     damieng  3948: # del_* - remove a parameter
                   3949: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3950: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3951: # key_* - date values
                   3952: # days_* - for date intervals
                   3953: # hours_* - for date intervals
                   3954: # minutes_* - for date intervals
                   3955: # seconds_* - for date intervals
                   3956: # done_* - for date intervals
                   3957: # typeof_* - parameter type
                   3958: # 
                   3959: # @param {Apache2::RequestRec} $r - the Apache request
                   3960: # @param {string} $crs - course number
                   3961: # @param {string} $dom - course domain
1.208     www      3962: sub storedata {
                   3963:     my ($r,$crs,$dom)=@_;
1.207     www      3964: # Set userlevel immediately
                   3965: # Do an intermediate store of course level
                   3966:     my $olddata=&readdata($crs,$dom);
1.124     www      3967:     my %newdata=();
                   3968:     undef %newdata;
                   3969:     my @deldata=();
1.576     raeburn  3970:     my @delrec=();
                   3971:     my @delnonrec=();
1.124     www      3972:     undef @deldata;
1.504     raeburn  3973:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3974:     my $now = time;
1.560     damieng  3975:     foreach my $key (keys(%env)) {
                   3976:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3977:             my $cmd=$1;
                   3978:             my $thiskey=$2;
1.576     raeburn  3979:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
1.588     raeburn  3980:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny' || $cmd eq 'setdeeplink');
1.576     raeburn  3981:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3982:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3983:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3984:                     $altkey = $thiskey;
                   3985:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   3986:                     if ($env{'form.rec_'.$thiskey}) {
                   3987:                         $recursive = 1;
                   3988:                     }
                   3989:                 }
                   3990:             }
1.560     damieng  3991:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 3992:             if ($tuname) {
1.576     raeburn  3993:                 $tkey=$thiskey;
1.560     damieng  3994:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  3995:                 if ($altkey) {
                   3996:                     $tkeynonrec = $tkey; 
                   3997:                     $tkeyrec = $altkey;
                   3998:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   3999:                 }
1.560     damieng  4000:             }
                   4001:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  4002:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   4003:                 if ($cmd eq 'set') {
                   4004:                     $data=$env{$key};
                   4005:                     $valmatch = '';
                   4006:                     $valchk = $data;
                   4007:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4008:                     $text = &mt('Saved modified parameter for');
                   4009:                     if ($typeof eq 'string_questiontype') {
                   4010:                         $name = 'type';
1.588     raeburn  4011:                     } elsif (($typeof eq 'string_lenient') || ($typeof eq 'string_deeplink')) {
                   4012:                         ($name) = ($typeof =~ /^string_(lenient|deeplink)$/);
1.563     damieng  4013:                         my $stringmatch = &standard_string_matches($typeof);
                   4014:                         if (ref($stringmatch) eq 'ARRAY') {
                   4015:                             foreach my $item (@{$stringmatch}) {
                   4016:                                 if (ref($item) eq 'ARRAY') {
                   4017:                                     my ($regexpname,$pattern) = @{$item};
                   4018:                                     if ($pattern ne '') {
                   4019:                                         if ($data =~ /$pattern/) {
                   4020:                                             $valmatch = $regexpname;
                   4021:                                             $valchk = '';
                   4022:                                             last;
                   4023:                                         }
1.560     damieng  4024:                                     }
1.549     raeburn  4025:                                 }
                   4026:                             }
                   4027:                         }
1.563     damieng  4028:                     } elsif ($typeof eq 'string_discussvote') {
                   4029:                         $name = 'discussvote';
                   4030:                     } elsif ($typeof eq 'string_examcode') {
                   4031:                         $name = 'examcode';
                   4032:                         if (&Apache::lonnet::validCODE($data)) {
                   4033:                             $valchk = 'valid';
                   4034:                         }
                   4035:                     } elsif ($typeof eq 'string_yesno') {
                   4036:                         if ($thiskey =~ /\.retrypartial$/) {
                   4037:                             $name = 'retrypartial';
                   4038:                         }
1.549     raeburn  4039:                     }
1.563     damieng  4040:                 } elsif ($cmd eq 'datepointer') {
                   4041:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   4042:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4043:                     $text = &mt('Saved modified date for');
                   4044:                     if ($typeof eq 'date_start') {
                   4045:                         if ($thiskey =~ /\.printstartdate$/) {
                   4046:                             $name = 'printstartdate';
                   4047:                             if (($data) && ($data > $now)) {
                   4048:                                 $valchk = 'future';
                   4049:                             }
1.560     damieng  4050:                         }
1.563     damieng  4051:                     } elsif ($typeof eq 'date_end') {
                   4052:                         if ($thiskey =~ /\.printenddate$/) {
                   4053:                             $name = 'printenddate';
                   4054:                             if (($data) && ($data < $now)) {
                   4055:                                 $valchk = 'past';
                   4056:                             }
1.560     damieng  4057:                         }
1.504     raeburn  4058:                     }
1.563     damieng  4059:                 } elsif ($cmd eq 'dateinterval') {
                   4060:                     $data=&get_date_interval_from_form($thiskey);
                   4061:                     if ($thiskey =~ /\.interval$/) {
                   4062:                         $name = 'interval';
                   4063:                         my $intervaltype = &get_intervaltype($name);
                   4064:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   4065:                         if (ref($intervalmatch) eq 'ARRAY') {
                   4066:                             foreach my $item (@{$intervalmatch}) {
                   4067:                                 if (ref($item) eq 'ARRAY') {
                   4068:                                     my ($regexpname,$pattern) = @{$item};
                   4069:                                     if ($pattern ne '') {
                   4070:                                         if ($data =~ /$pattern/) {
                   4071:                                             $valmatch = $regexpname;
                   4072:                                             $valchk = '';
                   4073:                                             last;
                   4074:                                         }
1.560     damieng  4075:                                     }
1.554     raeburn  4076:                                 }
                   4077:                             }
                   4078:                         }
                   4079:                     }
1.563     damieng  4080:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4081:                     $text = &mt('Saved modified date for');
1.554     raeburn  4082:                 }
1.576     raeburn  4083:                 if ($recursive) {
1.563     damieng  4084:                     $namematch = 'maplevelrecurse';
1.560     damieng  4085:                 }
1.563     damieng  4086:                 if (($name ne '') || ($namematch ne '')) {
                   4087:                     my ($needsrelease,$needsnewer);
                   4088:                     if ($name ne '') {
                   4089:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  4090:                         if ($needsrelease) {
                   4091:                             unless ($got_chostname) {
1.563     damieng  4092:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  4093:                                 $got_chostname = 1;
                   4094:                             }
1.563     damieng  4095:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   4096:                                                                 $needsrelease,
                   4097:                                                                 $cmajor,$cminor);
                   4098:                         }
                   4099:                     }
                   4100:                     if ($namematch ne '') {
                   4101:                         if ($needsnewer) {
                   4102:                             undef($namematch);
1.560     damieng  4103:                         } else {
1.563     damieng  4104:                             my $currneeded;
                   4105:                             if ($needsrelease) {
                   4106:                                 $currneeded = $needsrelease;
                   4107:                             }
                   4108:                             $needsrelease =
                   4109:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   4110:                             if (($needsrelease) &&
                   4111:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   4112:                                 unless ($got_chostname) {
                   4113:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   4114:                                     $got_chostname = 1;
                   4115:                                 }
                   4116:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   4117:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   4118:                             } else {
                   4119:                                 undef($namematch);
                   4120:                             }
1.560     damieng  4121:                         }
1.557     raeburn  4122:                     }
1.563     damieng  4123:                     if ($needsnewer) {
                   4124:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   4125:                                                             $chostname,$cmajor,
                   4126:                                                             $cminor,$needsrelease));
                   4127:                         next;
                   4128:                     }
1.504     raeburn  4129:                 }
1.576     raeburn  4130:                 my ($reconlychg,$haschange,$storekey);
                   4131:                 if ($tuname) {
                   4132:                     my $ustorekey;
                   4133:                     if ($altkey) {
                   4134:                         if ($recursive) {
                   4135:                             if (exists($$olddata{$thiskey})) {
                   4136:                                 if ($$olddata{$thiskey} eq $data) {
                   4137:                                     $reconlychg = 1;
                   4138:                                 }
                   4139:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   4140:                             }
                   4141:                             if (exists($$olddata{$altkey})) {
                   4142:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4143:                                     $haschange = 1;
                   4144:                                 }
                   4145:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4146:                                 $haschange = 1;
                   4147:                             }
                   4148:                             $ustorekey = $tkeyrec;
                   4149:                         } else {
                   4150:                             if (exists($$olddata{$altkey})) {
                   4151:                                 if ($$olddata{$altkey} eq $data) {
                   4152:                                     $reconlychg = 1;
                   4153:                                 }
                   4154:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   4155:                             }
                   4156:                             if (exists($$olddata{$thiskey})) {
                   4157:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4158:                                     $haschange = 1;
                   4159:                                 }
                   4160:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4161:                                 $haschange = 1;
                   4162:                             }
                   4163:                             $ustorekey = $tkeynonrec;
                   4164:                         }
                   4165:                     } else {
                   4166:                         if (exists($$olddata{$tkey})) {
                   4167:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   4168:                                 $haschange = 1;
                   4169:                             }
                   4170:                             $ustorekey = $tkey;
                   4171:                         }
                   4172:                     }
                   4173:                     if ($haschange || $reconlychg)  {
                   4174:                         unless ($env{'form.del_'.$thiskey}) {
                   4175:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   4176:                                                                      $ustorekey.'.type' => $typeof},
                   4177:                                                                      $tudom,$tuname) eq 'ok') {
                   4178:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   4179:                                 $r->print('<br />'.$text.' '.
                   4180:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   4181:                             } else {
                   4182:                                 $r->print('<div class="LC_error">'.
                   4183:                                           &mt('Error saving parameters').'</div>');
                   4184:                             }
                   4185:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4186:                         }
                   4187:                     }
                   4188:                 } else {
                   4189:                     if ($altkey) {
                   4190:                         if ($recursive) {
                   4191:                             if (exists($$olddata{$thiskey})) {
                   4192:                                 if ($$olddata{$thiskey} eq $data) {
                   4193:                                     $reconlychg = 1;
                   4194:                                 }
                   4195:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   4196:                             }
                   4197:                             if (exists($$olddata{$altkey})) {
                   4198:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4199:                                     $haschange = 1;
                   4200:                                 }
                   4201:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4202:                                 $haschange = 1;
                   4203:                             }
                   4204:                             $storekey = $altkey;
1.563     damieng  4205:                         } else {
1.576     raeburn  4206:                             if (exists($$olddata{$altkey})) {
                   4207:                                 if ($$olddata{$altkey} eq $data) {
                   4208:                                     $reconlychg = 1;
                   4209:                                 }
                   4210:                                 push(@delrec,($altkey,$altkey.'.type'));
                   4211:                             } 
                   4212:                             if (exists($$olddata{$thiskey})) {
                   4213:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4214:                                     $haschange = 1;
                   4215:                                 }
                   4216:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4217:                                 $haschange = 1;
                   4218:                             }
                   4219:                             $storekey = $thiskey;
1.563     damieng  4220:                         }
1.560     damieng  4221:                     } else {
1.576     raeburn  4222:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4223:                             $haschange = 1;
                   4224:                             $storekey = $thiskey;
                   4225:                         }
                   4226:                     }
                   4227:                 }
                   4228:                 if ($reconlychg || $haschange) {
                   4229:                     unless ($env{'form.del_'.$thiskey}) {
                   4230:                         $newdata{$storekey}=$data;
                   4231:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  4232:                     }
                   4233:                 }
                   4234:             } elsif ($cmd eq 'del') {
                   4235:                 if ($tuname) {
1.576     raeburn  4236:                     my $error;
                   4237:                     if ($altkey) {  
                   4238:                         if (exists($$olddata{$altkey})) {
                   4239:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4240:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   4241:                                 if ($recursive) {
                   4242:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4243:                                 }
                   4244:                             } elsif ($recursive) {
                   4245:                                 $error = 1;
                   4246:                             }
                   4247:                         }
                   4248:                         if (exists($$olddata{$thiskey})) {
                   4249:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4250:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   4251:                                 unless ($recursive) {
                   4252:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4253:                                 }
                   4254:                             } elsif (!$recursive) {
                   4255:                                 $error = 1;
                   4256:                             }
                   4257:                         }
1.560     damieng  4258:                     } else {
1.576     raeburn  4259:                         if (exists($$olddata{$thiskey})) {
                   4260:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   4261:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   4262:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4263:                             } else {
                   4264:                                 $error = 1;
                   4265:                             }
                   4266:                         }
                   4267:                     }
                   4268:                     if ($error) { 
1.560     damieng  4269:                         $r->print('<div class="LC_error">'.
                   4270:                             &mt('Error deleting parameters').'</div>');
                   4271:                     }
                   4272:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4273:                 } else {
1.576     raeburn  4274:                     if ($altkey) {
                   4275:                         if (exists($$olddata{$altkey})) {
                   4276:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   4277:                                 push(@deldata,($altkey,$altkey.'.type'));
                   4278:                             }
                   4279:                         }
                   4280:                         if (exists($$olddata{$thiskey})) {
                   4281:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   4282:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   4283:                             }
                   4284:                         }
                   4285:                     } elsif (exists($$olddata{$thiskey})) {
                   4286:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   4287:                     }
1.560     damieng  4288:                 }
1.473     amueller 4289:             }
                   4290:         }
                   4291:     }
1.207     www      4292: # Store all course level
1.144     www      4293:     my $delentries=$#deldata+1;
1.576     raeburn  4294:     my @alldels;
                   4295:     if (@delrec) {
                   4296:         push(@alldels,@delrec);
                   4297:     }
                   4298:     if (@delnonrec) {
                   4299:         push(@alldels,@delnonrec);
                   4300:     }
                   4301:     if (@deldata) {
                   4302:         push(@alldels,@deldata);
                   4303:     }
1.548     raeburn  4304:     my @newdatakeys=keys(%newdata);
1.144     www      4305:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4306:     my ($delresult,$devalidate);
                   4307:     if (@alldels) {
                   4308:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4309:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4310:             &log_parmset(\%loghash,1);
1.576     raeburn  4311:             if ($delentries) {
                   4312:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4313:             }
                   4314:         } elsif ($delentries) {
1.560     damieng  4315:             $r->print('<div class="LC_error">'.
                   4316:                 &mt('Error deleting parameters').'</div>');
                   4317:         }
1.576     raeburn  4318:         $devalidate = 1; 
1.144     www      4319:     }
                   4320:     if ($putentries) {
1.560     damieng  4321:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4322:                     &log_parmset(\%newdata,0);
                   4323:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4324:         } else {
                   4325:             $r->print('<div class="LC_error">'.
                   4326:                 &mt('Error saving parameters').'</div>');
                   4327:         }
1.576     raeburn  4328:         $devalidate = 1; 
                   4329:     }
                   4330:     if ($devalidate) {
1.560     damieng  4331:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4332:     }
1.208     www      4333: }
1.207     www      4334: 
1.563     damieng  4335: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4336: #
                   4337: # @param {string} $key - the key
                   4338: # @returns {Array}
1.208     www      4339: sub extractuser {
                   4340:     my $key=shift;
1.350     albertel 4341:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4342: }
1.206     www      4343: 
1.563     damieng  4344: # Parses a parameter key and returns the components.
                   4345: #
                   4346: # @param {string} $key - 
                   4347: # @param {hash reference} $listdata - 
                   4348: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4349: sub parse_listdata_key {
                   4350:     my ($key,$listdata) = @_;
                   4351:     # split into student/section affected, and
                   4352:     # the realm (folder/resource part and parameter
1.446     bisitz   4353:     my ($student,$realm) =
1.473     amueller 4354:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4355:     # if course wide student would be undefined
                   4356:     if (!defined($student)) {
1.560     damieng  4357:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4358:     }
                   4359:     # strip off the .type if it's not the Question type parameter
                   4360:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4361:         $realm=~s/\.type//;
1.381     albertel 4362:     }
                   4363:     # split into resource+part and parameter name
1.388     albertel 4364:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4365:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4366:     return ($student,$res,$part,$parm);
                   4367: }
                   4368: 
1.563     damieng  4369: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4370: #
                   4371: # @param {Apache2::RequestRec} $r - the Apache request
                   4372: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4373: # @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
                   4374: # @param {string} $sortorder - realmstudent|studentrealm
                   4375: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4376: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4377: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4378: # @returns{integer} - number of $listdata parameters processed
1.208     www      4379: sub listdata {
1.568     raeburn  4380:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4381:     
1.207     www      4382: # Start list output
1.206     www      4383: 
1.122     www      4384:     my $oldsection='';
                   4385:     my $oldrealm='';
                   4386:     my $oldpart='';
1.123     www      4387:     my $pointer=0;
1.124     www      4388:     $tableopen=0;
1.145     www      4389:     my $foundkeys=0;
1.248     albertel 4390:     my %keyorder=&standardkeyorder();
1.381     albertel 4391: 
1.552     raeburn  4392:     my ($secidx,%grouphash);
                   4393:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4394:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4395:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4396:             %grouphash = &Apache::longroup::coursegroups();
                   4397:         } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  4398:             map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  4399:         }
1.552     raeburn  4400:     }
                   4401: 
1.576     raeburn  4402:     foreach my $key (sort {
1.560     damieng  4403:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4404:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4405: 
1.560     damieng  4406:         # get the numerical order for the param
                   4407:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4408:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4409: 
1.560     damieng  4410:         my $result=0;
1.381     albertel 4411: 
1.560     damieng  4412:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4413:             if ($ares     ne $bres    ) {
1.560     damieng  4414:                 $result = ($ares     cmp $bres);
1.446     bisitz   4415:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4416:                 $result = ($astudent cmp $bstudent);
                   4417:             } elsif ($apart    ne $bpart   ) {
                   4418:                 $result = ($apart    cmp $bpart);
                   4419:             }
                   4420:         } else {
                   4421:             if      ($astudent ne $bstudent) {
                   4422:                 $result = ($astudent cmp $bstudent);
                   4423:             } elsif ($ares     ne $bres    ) {
                   4424:                 $result = ($ares     cmp $bres);
                   4425:             } elsif ($apart    ne $bpart   ) {
                   4426:                 $result = ($apart    cmp $bpart);
                   4427:             }
1.473     amueller 4428:         }
1.446     bisitz   4429: 
1.560     damieng  4430:         if (!$result) {
1.381     albertel 4431:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4432:                 $result = ($aparm <=> $bparm);
1.381     albertel 4433:             } elsif (defined($aparm)) {
1.560     damieng  4434:                 $result = -1;
1.381     albertel 4435:             } elsif (defined($bparm)) {
1.560     damieng  4436:                 $result = 1;
                   4437:             }
1.473     amueller 4438:         }
1.381     albertel 4439: 
1.560     damieng  4440:         $result;
                   4441:         
1.576     raeburn  4442:     } keys(%{$listdata})) { # foreach my $key
                   4443:         my $thiskey = $key;
1.560     damieng  4444:         if ($$listdata{$thiskey.'.type'}) {
                   4445:             my $thistype=$$listdata{$thiskey.'.type'};
                   4446:             if ($$resourcedata{$thiskey.'.type'}) {
                   4447:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4448:             }
                   4449:             my ($middle,$part,$name)=
1.572     damieng  4450:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4451:             my $section=&mt('All Students');
1.576     raeburn  4452:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4453:             if ($middle=~/^\[(.*)\]/) {
                   4454:                 my $issection=$1;
                   4455:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4456:                     my ($stuname,$studom) = ($1,$2);
                   4457:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4458:                         if (ref($classlist) eq 'HASH') {
                   4459:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4460:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4461:                             }
                   4462:                         }
                   4463:                     }
                   4464:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4465:                 } else {
                   4466:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4467:                         if (exists($grouphash{$issection})) {
                   4468:                             $section=&mt('Group').': '.$issection;
                   4469:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4470:                             $section = &mt('Section').': '.$issection;
                   4471:                         } else {
                   4472:                             next; 
1.552     raeburn  4473:                         }
1.560     damieng  4474:                     } else {
                   4475:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4476:                     }
                   4477:                 }
1.560     damieng  4478:                 $middle=~s/^\[(.*)\]//;
                   4479:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4480:                 $readonly = 1;
                   4481:             }
                   4482:             $middle=~s/\.+$//;
                   4483:             $middle=~s/^\.+//;
                   4484:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4485:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4486:             if ($caller eq 'overview') {
                   4487:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4488:                     $mapurl = $1;
                   4489:                     $maplevel = $2;
                   4490:                     $is_map = 1;
                   4491:                 }
                   4492:             } elsif ($caller eq 'newoverview') {
                   4493:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4494:                     $mapurl = $1;
                   4495:                     $maplevel = $2;
                   4496:                     $is_map = 1;
                   4497:                 }
                   4498:             }
                   4499:             if ($is_map) {
1.560     damieng  4500:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4501:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4502:                     if ($caller eq 'newoverview') {
                   4503:                         my $altkey = $thiskey;
                   4504:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4505:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4506:                             $is_recursive = 1;
                   4507:                             if ($$resourcedata{$altkey.'.type'}) {
                   4508:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4509:                             }
                   4510:                             $showval = $$resourcedata{$altkey};
                   4511:                         }
                   4512:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4513:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4514:                         $is_recursive = 1;
                   4515:                     }
1.560     damieng  4516:                 }
                   4517:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4518:             } elsif ($middle) {
                   4519:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4520:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4521:                     ': '.&Apache::lonnet::gettitle($middle).
                   4522:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4523:                     $id.')</span></span>';
                   4524:             }
                   4525:             if ($sortorder eq 'realmstudent') {
                   4526:                 if ($realm ne $oldrealm) {
                   4527:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4528:                     $oldrealm=$realm;
                   4529:                     $oldsection='';
                   4530:                 }
                   4531:                 if ($section ne $oldsection) {
                   4532:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4533:                     $oldsection=$section;
                   4534:                     $oldpart='';
                   4535:                 }
1.552     raeburn  4536:             } else {
1.560     damieng  4537:                 if ($section ne $oldsection) {
                   4538:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4539:                     $oldsection=$section;
                   4540:                     $oldrealm='';
                   4541:                 }
                   4542:                 if ($realm ne $oldrealm) {
                   4543:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4544:                     $oldrealm=$realm;
                   4545:                     $oldpart='';
1.552     raeburn  4546:                 }
                   4547:             }
1.560     damieng  4548:             if ($part ne $oldpart) {
                   4549:                 $r->print(&tableend().
                   4550:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4551:                 $oldpart=$part;
1.556     raeburn  4552:             }
1.560     damieng  4553:     #
                   4554:     # Ready to print
                   4555:     #
1.470     raeburn  4556:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4557:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4558:                 &Apache::loncommon::start_data_table_row().
                   4559:                 '<td><b>'.&mt($parmitem).
                   4560:                 '</b></td>');
                   4561:             unless ($readonly) {
                   4562:                 $r->print('<td><input type="checkbox" name="del_'.
                   4563:                         $thiskey.'" /></td>');
                   4564:             }
                   4565:             $r->print('<td>');
                   4566:             $foundkeys++;
                   4567:             if (&isdateparm($thistype)) {
                   4568:                 my $jskey='key_'.$pointer;
                   4569:                 my $state;
                   4570:                 $pointer++;
                   4571:                 if ($readonly) {
                   4572:                     $state = 'disabled';
                   4573:                 }
                   4574:                 $r->print(
                   4575:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4576:                                                         $jskey,
1.576     raeburn  4577:                                                         $showval,
1.560     damieng  4578:                                                         '',1,$state));
                   4579:                 unless  ($readonly) {
                   4580:                     $r->print(
                   4581:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4582:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4583:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4584:     &date_sanity_info($showval)
1.560     damieng  4585:                     );
                   4586:                 }
                   4587:             } elsif ($thistype eq 'date_interval') {
                   4588:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4589:                           $showval,$readonly));
1.560     damieng  4590:             } elsif ($thistype =~ m/^string/) {
                   4591:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4592:                           $showval,$name,$readonly));
1.560     damieng  4593:             } else {
1.576     raeburn  4594:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4595:             }
1.560     damieng  4596:             unless ($readonly) {
                   4597:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4598:                         $thistype.'" />');
1.552     raeburn  4599:             }
1.576     raeburn  4600:             $r->print('</td>');
                   4601:             if ($is_map) {
                   4602:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4603:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4604:                 } else {
                   4605:                     my ($disabled,$recon,$recoff);
                   4606:                     if ($readonly) {
                   4607:                         $disabled = ' disabled="disabled"';
                   4608:                     }
                   4609:                     if ($is_recursive) {
                   4610:                         $recon = ' checked="checked"';
                   4611:                     } else {
                   4612:                         $recoff = ' checked="checked"';
                   4613:                     }
                   4614:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4615:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4616:                 }
                   4617:             }
                   4618:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4619:         }
1.121     www      4620:     }
1.208     www      4621:     return $foundkeys;
                   4622: }
                   4623: 
1.563     damieng  4624: # Returns a string representing the interval, directly using form data matching the given key.
                   4625: # The returned string may also include information related to proctored exams.
                   4626: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4627: #
                   4628: # @param {string} $key - suffix for form fields related to the interval
                   4629: # @returns {string}
1.385     albertel 4630: sub get_date_interval_from_form {
                   4631:     my ($key) = @_;
                   4632:     my $seconds = 0;
                   4633:     foreach my $which (['days', 86400],
1.473     amueller 4634:                ['hours', 3600],
                   4635:                ['minutes', 60],
                   4636:                ['seconds',  1]) {
1.560     damieng  4637:         my ($name, $factor) = @{ $which };
                   4638:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4639:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4640:         }
1.473     amueller 4641:     }
1.560     damieng  4642:     if (($key =~ /\.interval$/) &&
                   4643:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4644:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4645:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4646:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4647:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4648:                 $seconds .= '_proctor';
                   4649:             }
                   4650:         } else {
                   4651:             $seconds .= $env{'form.done_'.$key}; 
                   4652:         }
                   4653:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4654:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4655:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4656:         }
1.554     raeburn  4657:     }
1.385     albertel 4658:     return $seconds;
                   4659: }
                   4660: 
                   4661: 
1.563     damieng  4662: # Returns HTML to enter a text value for a parameter.
                   4663: #
                   4664: # @param {string} $thiskey - parameter key
                   4665: # @param {string} $showval - the current value
                   4666: # @param {boolean} $readonly - true if the field should not be made editable
                   4667: # @returns {string}
1.383     albertel 4668: sub default_selector {
1.552     raeburn  4669:     my ($thiskey, $showval, $readonly) = @_;
                   4670:     my $disabled;
                   4671:     if ($readonly) {
                   4672:         $disabled = ' disabled="disabled"';
                   4673:     }
                   4674:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4675: }
                   4676: 
1.563     damieng  4677: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4678: #
                   4679: # @param {string} $thiskey - parameter key
                   4680: # @param {string} $showval - the current value
                   4681: # @param {boolean} $readonly - true if the fields should not be made editable
                   4682: # @returns {string}
1.549     raeburn  4683: sub string_ip_selector {
1.552     raeburn  4684:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4685:     my %access = (
                   4686:                    allow => [],
                   4687:                    deny  => [],
                   4688:                  );
                   4689:     if ($showval ne '') {
                   4690:         my @current;
                   4691:         if ($showval =~ /,/) {
                   4692:             @current = split(/,/,$showval);
                   4693:         } else {
                   4694:             @current = ($showval);
                   4695:         }
                   4696:         foreach my $item (@current) {
                   4697:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4698:                 push(@{$access{'deny'}},$1);
                   4699:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4700:                 push(@{$access{'allow'}},$item);
                   4701:             }
                   4702:         }
                   4703:     }
                   4704:     if (!@{$access{'allow'}}) {
                   4705:         @{$access{'allow'}} = ('');
                   4706:     }
                   4707:     if (!@{$access{'deny'}}) {
                   4708:         @{$access{'deny'}} = ('');
                   4709:     }
1.552     raeburn  4710:     my ($disabled,$addmore);
1.567     raeburn  4711:     if ($readonly) {
1.552     raeburn  4712:         $disabled=' disabled="disabled"';
                   4713:     } else {
                   4714:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4715:     }
1.549     raeburn  4716:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4717: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4718:     foreach my $acctype ('allow','deny') {
                   4719:         $output .= '
                   4720: <td valign="top">
                   4721: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4722:   <div class="LC_string_ipacc_inner">'."\n";
                   4723:         my $num = 0;
                   4724:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4725:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4726:             if ($num > 0) {
                   4727:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4728:             }
                   4729:             $output .= '</div>'."\n";
                   4730:             $num ++;
                   4731:         }
                   4732:         $output .= '
1.552     raeburn  4733:   </div>'.$addmore.'
1.549     raeburn  4734: </div>
                   4735: </td>';
                   4736:    }
                   4737:    $output .= '
                   4738: </tr>
                   4739: </table>'."\n";
                   4740:     return $output;
                   4741: }
                   4742: 
1.588     raeburn  4743: sub string_deeplink_selector {
                   4744:     my ($thiskey, $showval, $readonly) = @_;
                   4745:     my (@components,%values,@current,%titles,%options,%optiontext,%defaults,%posslti);
                   4746:     @components = ('listing','scope','urls');
                   4747:     %titles = &Apache::lonlocal::texthash (
                   4748:                   listing => 'In Contents and/or Gradebook',
                   4749:                   scope   => 'Access scope for link',
                   4750:                   urls    => 'Supported link types',
                   4751:               );
                   4752:     %options = (
                   4753:                    listing => ['full','absent','grades','details','datestatus'],
                   4754:                    scope   => ['res','map','rec'],
                   4755:                    urls    => ['any','only','key','lti'],
                   4756:                );
                   4757:     %optiontext = &Apache::lonlocal::texthash (
                   4758:                     full       => 'Listed (linked) in both',
                   4759:                     absent     => 'Not listed',
                   4760:                     grades     => 'Listed in grades only',
                   4761:                     details    => 'Listed (unlinked) in both',
                   4762:                     datestatus => 'Listed (unlinked) inc. status in both',
                   4763:                     res        => 'resource only',
                   4764:                     map        => 'enclosing map/folder',
                   4765:                     rec        => 'recursive map/folder',
                   4766:                     any        => 'regular + deep',
                   4767:                     only       => 'deep only',
                   4768:                     key        => 'deep with key',
                   4769:                     lti        => 'deep with LTI launch',
                   4770:                   );
                   4771:     if ($showval =~ /,/) {
                   4772:         @current = split(/,/,$showval);
                   4773:         ($values{'listing'}) = ($current[0] =~ /^(full|absent|grades|details|datestatus)$/);
                   4774:         ($values{'scope'}) = ($current[1] =~ /^(res|map|rec)$/);
                   4775:         ($values{'urls'}) = ($current[2] =~ /^(any|only|key:\w+|lti:\d+)$/);
                   4776:     } else {
                   4777:         $defaults{'listing'} = 'full';
                   4778:         $defaults{'scope'} = 'res';
                   4779:         $defaults{'urls'} = 'any';
                   4780:     }
                   4781:     my $disabled;
                   4782:     if ($readonly) {
                   4783:         $disabled=' disabled="disabled"';
                   4784:     }
                   4785:     my %lti = 
                   4786:         &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   4787:                                         'provider');
                   4788:     foreach my $item (keys(%lti)) {
                   4789:         if (ref($lti{$item}) eq 'HASH') {
                   4790:             unless ($lti{$item}{'requser'}) {
                   4791:                 $posslti{$item} = $lti{$item}{'consumer'};
                   4792:             }
                   4793:         }
                   4794:     }
                   4795:     my $output = '<input type="hidden" name="set_'.$thiskey.'" /><table><tr>';
                   4796:     foreach my $item ('listing','scope','urls') {
                   4797:         $output .= '<th>'.$titles{$item}.'</th>';
                   4798:     }
                   4799:     $output .= '</tr><tr>';
                   4800:     foreach my $item (@components) {
                   4801:         $output .= '<td>';
                   4802:         if ($item eq 'urls') {
                   4803:             my $selected = $values{$item};
                   4804:             foreach my $option (@{$options{$item}}) {
                   4805:                 if ($option eq 'lti') {
                   4806:                     next unless (keys(%posslti));
                   4807:                 }
                   4808:                 my $checked;
                   4809:                 if ($selected =~ /^\Q$option\E/) {
                   4810:                     $checked = ' checked="checked"';
                   4811:                 }
                   4812:                 my $onclick;
                   4813:                 unless ($readonly) {
                   4814:                     my $esc_key = &js_escape($thiskey);
                   4815:                     $onclick = ' onclick="toggleDeepLink(this.form,'."'$item','$esc_key'".');"';
                   4816:                 }
                   4817:                 $output .= '<span class="LC_nobreak"><label>'.
                   4818:                            '<input type="radio" name="deeplink_'.$item.'_'.$thiskey.'" value="'.$option.'"'.$onclick.$disabled.$checked.' />'."\n".
                   4819:                            $optiontext{$option}.'</label>';
                   4820:                 if ($option eq 'key') {
                   4821:                     my $visibility="hidden";
                   4822:                     my $currkey;
                   4823:                     if ($checked) {
                   4824:                         $visibility = "text";
                   4825:                         $currkey = (split(/\:/,$values{$item}))[1];
                   4826:                     }
                   4827:                     $output .= '&nbsp;'.
                   4828:                         '<input type="'.$visibility.'" name="deeplink_'.$option.'_'.$thiskey.'" id="deeplink_'.$option.'_'.$item.'_'.$thiskey.'" value="'.$currkey.'" size="6"'.$disabled.' />';
                   4829:                 } elsif ($option eq 'lti') {
                   4830:                     my $display="none";
                   4831:                     my ($currlti,$blankcheck);
                   4832:                     if ($checked) {
                   4833:                         $display = 'inline-block';
                   4834:                         $currlti = (split(/\:/,$values{$item}))[1];
                   4835:                     } else {
                   4836:                         $blankcheck = ' selected="selected"';
                   4837:                     }
                   4838:                     $output .= '<div id="deeplinkdiv_'.$option.'_'.$item.'_'.$thiskey.'"'.
                   4839:                                ' style="display: '.$display.'">&nbsp;<select name="'.
                   4840:                                'deeplink_'.$option.'_'.$thiskey.'"'.$disabled.'>'.
                   4841:                                '<option value=""'.$blankcheck.'>'.&mt('Select Provider').'</option>'."\n";
                   4842:                     foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   4843:                         my $selected;
                   4844:                         if ($lti == $currlti) {
                   4845:                             $selected = ' selected="selected"';
                   4846:                         }
                   4847:                         $output .= '<option value="'.$lti.'"'.$selected.'>'.$posslti{$lti}.'</option>';
                   4848:                     }
                   4849:                     $output .= '</select></div>';
                   4850:                 }
                   4851:                 $output .= '</span> ';
                   4852:             }
                   4853:         } else {
                   4854:             my $selected = $values{$item};
                   4855:             my $defsel;
                   4856:             if ($selected eq '') {
                   4857:                 $defsel = ' selected="selected"';
                   4858:             }
                   4859:             $output .= '<select name="deeplink_'.$item.'_'.$thiskey.'"'.$disabled.'>'."\n".
                   4860:                        '<option value=""'.$defsel.'>'.&mt('Please select').'</option>'."\n";
                   4861:             foreach my $option (@{$options{$item}}) {
                   4862:                 $output .= '<option value="'.$option.'"';
                   4863:                 if ($option eq $selected) {
                   4864:                     $output .= ' selected="selected"';
                   4865:                 }
                   4866:                 $output .= '>'.$optiontext{$option}.'</option>';
                   4867:             }
                   4868:             $output .= '</select>';
                   4869:         }
                   4870:         $output .= '</td>';
                   4871:     }
                   4872:     $output .= '</tr></table>'."\n";
                   4873:     return $output;
                   4874: }
                   4875: 
1.560     damieng  4876: 
                   4877: { # block using some constants related to parameter types (overview mode)
                   4878: 
1.446     bisitz   4879: my %strings =
1.383     albertel 4880:     (
                   4881:      'string_yesno'
                   4882:              => [[ 'yes', 'Yes' ],
1.560     damieng  4883:                  [ 'no', 'No' ]],
1.383     albertel 4884:      'string_problemstatus'
                   4885:              => [[ 'yes', 'Yes' ],
1.473     amueller 4886:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4887:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4888:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4889:      'string_questiontype'
                   4890:              => [[ 'problem', 'Standard Problem'],
                   4891:                  [ 'survey', 'Survey'],
                   4892:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4893:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4894:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4895:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4896:                  [ 'practice', 'Practice'],
                   4897:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4898:      'string_lenient'
                   4899:              => [['yes', 'Yes' ],
                   4900:                  [ 'no', 'No' ],
1.549     raeburn  4901:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4902:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4903:      'string_discussvote'
                   4904:              => [['yes','Yes'],
                   4905:                  ['notended','Yes, unless discussion ended'],
                   4906:                  ['no','No']],
1.549     raeburn  4907:      'string_ip'
                   4908:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
1.587     raeburn  4909:                  ['_denyfrom_','Hostname(s) or IP(s) from which access is disallowed']], 
                   4910:      'string_deeplink'
1.588     raeburn  4911:              => [['on','Set choices for link protection, resource listing, and access scope']],
1.587     raeburn  4912:     );
                   4913:    
1.383     albertel 4914: 
1.549     raeburn  4915: my %stringmatches = (
                   4916:          'string_lenient'
                   4917:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4918:          'string_ip'
                   4919:               => [['_allowfrom_','[^\!]+'],
                   4920:                   ['_denyfrom_','\!']],
1.588     raeburn  4921:          'string_deeplink'
                   4922:               => [['on','^(full|absent|grades|details|datestatus)\,(res|map|rec)\,(any|only|key\:\w+|lti\:\d+)$']],
1.549     raeburn  4923:     );
                   4924: 
                   4925: my %stringtypes = (
                   4926:                     type         => 'string_questiontype',
                   4927:                     lenient      => 'string_lenient',
                   4928:                     retrypartial => 'string_yesno',
                   4929:                     discussvote  => 'string_discussvote',
                   4930:                     examcode     => 'string_examcode',
                   4931:                     acc          => 'string_ip',
1.587     raeburn  4932:                     deeplink     => 'string_deeplink',
1.549     raeburn  4933:                   );
                   4934: 
1.563     damieng  4935: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4936: # Used by courseprefs.
                   4937: #
                   4938: # @param {string} $string_type - a parameter type for strings
                   4939: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4940: sub standard_string_options {
                   4941:     my ($string_type) = @_;
                   4942:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4943:         return $strings{$string_type};
                   4944:     }
                   4945:     return;
                   4946: }
1.383     albertel 4947: 
1.563     damieng  4948: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4949: #
                   4950: # @param {string} $string_type - a parameter type for strings
                   4951: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4952: sub standard_string_matches {
                   4953:     my ($string_type) = @_;
                   4954:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4955:         return $stringmatches{$string_type};
                   4956:     }
                   4957:     return;
                   4958: }
                   4959: 
1.563     damieng  4960: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4961: #
                   4962: # @param {string} $name - parameter name
                   4963: # @returns {string}
1.549     raeburn  4964: sub get_stringtype {
                   4965:     my ($name) = @_;
                   4966:     if (exists($stringtypes{$name})) {
                   4967:         return $stringtypes{$name};
                   4968:     }
                   4969:     return;
                   4970: }
                   4971: 
1.563     damieng  4972: # Returns HTML to edit a string parameter.
                   4973: #
                   4974: # @param {string} $thistype - parameter type
                   4975: # @param {string} $thiskey - parameter key
                   4976: # @param {string} $showval - parameter current value
                   4977: # @param {string} $name - parameter name
                   4978: # @param {boolean} $readonly - true if the values should not be made editable
                   4979: # @returns {string}
1.383     albertel 4980: sub string_selector {
1.552     raeburn  4981:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4982: 
1.383     albertel 4983:     if (!exists($strings{$thistype})) {
1.552     raeburn  4984:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4985:     }
                   4986: 
1.504     raeburn  4987:     my %skiptype;
1.514     raeburn  4988:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4989:             ($thistype eq 'string_lenient') ||
                   4990:             ($thistype eq 'string_discussvote') ||
                   4991:             ($thistype eq 'string_ip') ||
1.588     raeburn  4992:             ($thistype eq 'string_deeplink') ||
1.560     damieng  4993:             ($name eq 'retrypartial')) {
1.504     raeburn  4994:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4995:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4996:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4997:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4998:             my $parmmatch;
                   4999:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   5000:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   5001:                     if (ref($item) eq 'ARRAY') {
                   5002:                         if ($parmval eq $item->[0]) {
                   5003:                             $parmmatch = $parmval;
                   5004:                             $parmval = '';
                   5005:                             last;
                   5006:                         }
                   5007:                     }
                   5008:                 }
                   5009:             }
                   5010:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  5011:             if ($needsrelease) {
                   5012:                 unless ($got_chostname) {
1.514     raeburn  5013:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  5014:                     $got_chostname = 1;
                   5015:                 }
1.557     raeburn  5016:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  5017:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  5018:                 if ($needsnewer) {
1.549     raeburn  5019:                     if ($parmmatch ne '') {
                   5020:                         $skiptype{$parmmatch} = 1;
                   5021:                     } elsif ($parmval ne '') {
                   5022:                         $skiptype{$parmval} = 1;
                   5023:                     }
1.504     raeburn  5024:                 }
                   5025:             }
                   5026:         }
                   5027:     }
1.549     raeburn  5028: 
                   5029:     if ($thistype eq 'string_ip') {
1.552     raeburn  5030:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.588     raeburn  5031:     } elsif ($thistype eq 'string_deeplink') {
                   5032:         return &string_deeplink_selector($thiskey,$showval,$readonly);
1.549     raeburn  5033:     }
1.504     raeburn  5034: 
1.552     raeburn  5035:     my ($result,$disabled);
                   5036: 
                   5037:     if ($readonly) {
                   5038:         $disabled = ' disabled="disabled"';
                   5039:     }
1.504     raeburn  5040:     my $numinrow = 3;
                   5041:     if ($thistype eq 'string_problemstatus') {
                   5042:         $numinrow = 2;
                   5043:     } elsif ($thistype eq 'string_questiontype') {
                   5044:         if (keys(%skiptype) > 0) {
                   5045:              $numinrow = 4;
                   5046:         }
                   5047:     }
                   5048:     my $rem;
                   5049:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   5050:         my $i=0;
                   5051:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   5052:             next unless (ref($possibilities) eq 'ARRAY');
                   5053:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  5054:             next if ($skiptype{$name});
1.504     raeburn  5055:             $rem = $i%($numinrow);
                   5056:             if ($rem == 0) {
                   5057:                 if ($i > 0) {
                   5058:                     $result .= '</tr>';
                   5059:                 }
                   5060:                 $result .= '<tr>';
                   5061:             }
1.549     raeburn  5062:             my $colspan;
                   5063:             if ($i == @{ $strings{$thistype} }-1) {
                   5064:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   5065:                 if ($rem) {
                   5066:                     my $colsleft = $numinrow - $rem;
                   5067:                     if ($colsleft) {
                   5068:                         $colspan = $colsleft+1;
                   5069:                         $colspan = ' colspan="'.$colspan.'"';
                   5070:                     }
                   5071:                 }
                   5072:             }
                   5073:             my ($add,$onchange,$css_class);
                   5074:             if ($thistype eq 'string_lenient') {
                   5075:                 if ($name eq 'weighted') {
                   5076:                     my $display;
                   5077:                     my %relatives = &Apache::lonlocal::texthash(
                   5078:                                         corrchkd     => 'Correct (checked)',
                   5079:                                         corrunchkd   => 'Correct (unchecked)',
                   5080:                                         incorrchkd   => 'Incorrect (checked)',
                   5081:                                         incorrunchkd => 'Incorrect (unchecked)',
                   5082:                     );
                   5083:                     my %textval = (
                   5084:                                     corrchkd     => '1.0',
                   5085:                                     corrunchkd   => '1.0',
                   5086:                                     incorrchkd   => '0.0',
                   5087:                                     incorrunchkd => '0.0',
                   5088:                     );
                   5089:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   5090:                         $textval{'corrchkd'} = $1;
                   5091:                         $textval{'corrunchkd'} = $2;
                   5092:                         $textval{'incorrchkd'} = $3;
                   5093:                         $textval{'incorrunchkd'} = $4;
                   5094:                         $display = 'inline';
                   5095:                         $showval = $name;
                   5096:                     } else {
                   5097:                         $display = 'none';
                   5098:                     }
                   5099:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   5100:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   5101:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   5102:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   5103:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  5104:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  5105:                                 '</td></tr>';
                   5106:                     }
                   5107:                     $add .= '</table></div>'."\n";
                   5108:                 }
                   5109:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   5110:                 $css_class = ' class="LC_lenient_radio"';
                   5111:             }
                   5112:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  5113:                        '<span class="LC_nobreak"><label>'.
                   5114:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  5115:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  5116:             if ($showval eq $name) {
                   5117:                 $result .= ' checked="checked"';
                   5118:             }
1.549     raeburn  5119:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  5120:             $i++;
                   5121:         }
                   5122:         $result .= '</tr>';
1.473     amueller 5123:     }
1.504     raeburn  5124:     if ($result) {
                   5125:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 5126:     }
                   5127:     return $result;
                   5128: }
                   5129: 
1.554     raeburn  5130: my %intervals =
                   5131:     (
                   5132:      'date_interval'
                   5133:              => [[ 'done', 'Yes' ],
1.558     raeburn  5134:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  5135:                  [ '', 'No' ]],
                   5136:     );
                   5137: 
                   5138: my %intervalmatches = (
                   5139:          'date_interval'
1.559     raeburn  5140:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   5141:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  5142:     );
                   5143: 
                   5144: my %intervaltypes = (
                   5145:                       interval => 'date_interval',
                   5146:     );
                   5147: 
1.563     damieng  5148: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   5149: #
                   5150: # @param {string} $interval_type - a parameter type for intervals
                   5151: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  5152: sub standard_interval_matches {
                   5153:     my ($interval_type) = @_;
                   5154:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   5155:         return $intervalmatches{$interval_type};
                   5156:     }
                   5157:     return;
                   5158: }
                   5159: 
1.563     damieng  5160: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   5161: #
                   5162: # @param {string} $name - parameter name
                   5163: # @returns {string}
1.554     raeburn  5164: sub get_intervaltype {
                   5165:     my ($name) = @_;
                   5166:     if (exists($intervaltypes{$name})) {
                   5167:         return $intervaltypes{$name};
                   5168:     }
                   5169:     return;
                   5170: }
                   5171: 
1.563     damieng  5172: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   5173: # Used by courseprefs.
                   5174: #
                   5175: # @param {string} $interval_type - a parameter type for intervals
                   5176: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  5177: sub standard_interval_options {
                   5178:     my ($interval_type) = @_;
                   5179:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   5180:         return $intervals{$interval_type};
                   5181:     }
                   5182:     return;
                   5183: }
                   5184: 
1.563     damieng  5185: # Returns HTML to edit a date interval parameter.
                   5186: #
                   5187: # @param {string} $thiskey - parameter key
                   5188: # @param {string} $name - parameter name
                   5189: # @param {string} $showval - parameter current value
                   5190: # @param {boolean} $readonly - true if the values should not be made editable
                   5191: # @returns {string}
1.554     raeburn  5192: sub date_interval_selector {
                   5193:     my ($thiskey, $name, $showval, $readonly) = @_;
                   5194:     my ($result,%skipval);
                   5195:     if ($name eq 'interval') {
                   5196:         my $intervaltype = &get_intervaltype($name);
                   5197:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   5198:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   5199:             next unless (ref($possibilities) eq 'ARRAY');
                   5200:             my ($parmval, $description) = @{ $possibilities };
                   5201:             my $parmmatch;
                   5202:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   5203:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   5204:                     if (ref($item) eq 'ARRAY') {
                   5205:                         if ($parmval eq $item->[0]) {
                   5206:                             $parmmatch = $parmval;
                   5207:                             $parmval = '';
                   5208:                             last;
                   5209:                         }
                   5210:                     }
                   5211:                 }
                   5212:             }
                   5213:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   5214:             if ($needsrelease) {
                   5215:                 unless ($got_chostname) {
                   5216:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   5217:                     $got_chostname = 1;
                   5218:                 }
1.557     raeburn  5219:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  5220:                                                        $needsrelease,$cmajor,$cminor);
                   5221:                 if ($needsnewer) {
                   5222:                     if ($parmmatch ne '') {
                   5223:                         $skipval{$parmmatch} = 1;
                   5224:                     } elsif ($parmval ne '') {
                   5225:                         $skipval{$parmval} = 1;
                   5226:                     }
                   5227:                 }
                   5228:             }
                   5229:         }
                   5230:     }
                   5231: 
                   5232:     my $currval = $showval;
                   5233:     foreach my $which (['days', 86400, 31],
                   5234:                ['hours', 3600, 23],
                   5235:                ['minutes', 60, 59],
                   5236:                ['seconds',  1, 59]) {
1.560     damieng  5237:         my ($name, $factor, $max) = @{ $which };
                   5238:         my $amount = int($showval/$factor);
                   5239:         $showval  %= $factor;
                   5240:         my %select = ((map {$_ => $_} (0..$max)),
                   5241:                 'select_form_order' => [0..$max]);
                   5242:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   5243:                             \%select,'',$readonly);
                   5244:         $result .= ' '.&mt($name);
1.554     raeburn  5245:     }
                   5246:     if ($name eq 'interval') {
                   5247:         unless ($skipval{'done'}) {
                   5248:             my $checkedon = '';
1.558     raeburn  5249:             my $checkedproc = '';
                   5250:             my $currproctorkey = '';
                   5251:             my $currprocdisplay = 'hidden';
1.559     raeburn  5252:             my $currdonetext = &mt('Done');
1.554     raeburn  5253:             my $checkedoff = ' checked="checked"';
1.559     raeburn  5254:             if ($currval =~ /^(?:\d+)_done$/) {
                   5255:                 $checkedon = ' checked="checked"';
                   5256:                 $checkedoff = '';
                   5257:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   5258:                 $currdonetext = $1;
1.554     raeburn  5259:                 $checkedon = ' checked="checked"';
                   5260:                 $checkedoff = '';
1.558     raeburn  5261:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   5262:                 $currproctorkey = $1;
                   5263:                 $checkedproc = ' checked="checked"';
                   5264:                 $checkedoff = '';
                   5265:                 $currprocdisplay = 'text';
1.559     raeburn  5266:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   5267:                 $currdonetext = $1;
                   5268:                 $currproctorkey = $2;
                   5269:                 $checkedproc = ' checked="checked"';
                   5270:                 $checkedoff = '';
                   5271:                 $currprocdisplay = 'text';
1.554     raeburn  5272:             }
1.558     raeburn  5273:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  5274:             my $disabled;
                   5275:             if ($readonly) {
                   5276:                 $disabled = ' disabled="disabled"';
                   5277:             }
1.558     raeburn  5278:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  5279:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  5280:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  5281:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  5282:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  5283:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  5284:                        &mt('Yes, with proctor key').'</label>'.
                   5285:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  5286:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  5287:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  5288:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  5289:         }
                   5290:     }
                   5291:     unless ($readonly) {
                   5292:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   5293:     }
                   5294:     return $result;
                   5295: }
                   5296: 
1.563     damieng  5297: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   5298: #
                   5299: # @param {string} $name - parameter name
                   5300: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5301: # @param {string} $value - parameter value
                   5302: # @param {string} $chostname - course server name
                   5303: # @param {integer} $cmajor - major version number
                   5304: # @param {integer} $cminor - minor version number
                   5305: # @param {string} $needsrelease - release version needed (major.minor)
                   5306: # @returns {string}
1.549     raeburn  5307: sub oldversion_warning {
1.557     raeburn  5308:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   5309:     my $standard_name = &standard_parameter_names($name);
                   5310:     if ($namematch) {
                   5311:         my $level = &standard_parameter_levels($namematch);
                   5312:         my $msg = '';
                   5313:         if ($level) {
                   5314:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   5315:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   5316:         } else {
                   5317:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   5318:                       $standard_name,'<b>','</b>');
                   5319:         }
                   5320:         return '<p class="LC_warning">'.$msg.'<br />'.
                   5321:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5322:                    $cmajor.'.'.$cminor,$chostname,
                   5323:                    $needsrelease).
                   5324:                    '</p>';
                   5325:     }
1.549     raeburn  5326:     my $desc;
                   5327:     my $stringtype = &get_stringtype($name);
                   5328:     if ($stringtype ne '') {
                   5329:         if ($name eq 'examcode') {
                   5330:             $desc = $value;
                   5331:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   5332:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   5333:                 next unless (ref($possibilities) eq 'ARRAY');
                   5334:                 my ($parmval, $description) = @{ $possibilities };
                   5335:                 my $parmmatch;
                   5336:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   5337:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   5338:                         if (ref($item) eq 'ARRAY') {
                   5339:                             my ($regexpname,$pattern) = @{$item};
                   5340:                             if ($parmval eq $regexpname) {
                   5341:                                 if ($value =~ /$pattern/) {
                   5342:                                     $desc = $description; 
                   5343:                                     $parmmatch = 1;
                   5344:                                     last;
                   5345:                                 }
                   5346:                             }
                   5347:                         }
                   5348:                     }
                   5349:                     last if ($parmmatch);
                   5350:                 } elsif ($parmval eq $value) {
                   5351:                     $desc = $description;
                   5352:                     last;
                   5353:                 }
                   5354:             }
                   5355:         }
                   5356:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   5357:         my $now = time;
                   5358:         if ($value =~ /^\d+$/) {
                   5359:             if ($name eq 'printstartdate') {
                   5360:                 if ($value > $now) {
                   5361:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5362:                 }
                   5363:             } elsif ($name eq 'printenddate') {
                   5364:                 if ($value < $now) {
                   5365:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5366:                 }
                   5367:             }
                   5368:         }
                   5369:     }
                   5370:     return '<p class="LC_warning">'.
1.557     raeburn  5371:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   5372:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   5373:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5374:        $cmajor.'.'.$cminor,$chostname,
                   5375:        $needsrelease).
                   5376:        '</p>';
1.549     raeburn  5377: }
                   5378: 
1.560     damieng  5379: } # end of block using some constants related to parameter types
                   5380: 
1.549     raeburn  5381: 
1.563     damieng  5382: 
                   5383: # Shifts all start and end dates in the current course by $shift.
1.389     www      5384: #
1.563     damieng  5385: # @param {integer} $shift - time to shift, in seconds
                   5386: # @returns {string} - error name or 'ok'
1.389     www      5387: sub dateshift {
                   5388:     my ($shift)=@_;
                   5389:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5390:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5391:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   5392: # ugly retro fix for broken version of types
1.548     raeburn  5393:     foreach my $key (keys(%data)) {
1.389     www      5394:         if ($key=~/\wtype$/) {
                   5395:             my $newkey=$key;
                   5396:             $newkey=~s/type$/\.type/;
                   5397:             $data{$newkey}=$data{$key};
                   5398:             delete $data{$key};
                   5399:         }
                   5400:     }
1.391     www      5401:     my %storecontent=();
1.389     www      5402: # go through all parameters and look for dates
1.548     raeburn  5403:     foreach my $key (keys(%data)) {
1.389     www      5404:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   5405:           my $newdate=$data{$key}+$shift;
1.391     www      5406:           $storecontent{$key}=$newdate;
1.389     www      5407:        }
                   5408:     }
1.391     www      5409:     my $reply=&Apache::lonnet::cput
                   5410:                 ('resourcedata',\%storecontent,$dom,$crs);
                   5411:     if ($reply eq 'ok') {
                   5412:        &log_parmset(\%storecontent);
                   5413:     }
                   5414:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   5415:     return $reply;
1.389     www      5416: }
                   5417: 
1.563     damieng  5418: # Overview mode UI to edit course parameters.
                   5419: #
                   5420: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5421: sub newoverview {
1.568     raeburn  5422:     my ($r,$parm_permission) = @_;
1.280     albertel 5423: 
1.208     www      5424:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5425:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5426:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5427:     my $readonly = 1;
                   5428:     if ($parm_permission->{'edit'}) {
                   5429:         undef($readonly);
                   5430:     }
1.414     droeschl 5431:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5432:         text=>"Overview Mode"});
1.523     raeburn  5433: 
                   5434:     my %loaditems = (
1.549     raeburn  5435:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5436:                     );
                   5437:     my $js = '
                   5438: <script type="text/javascript">
                   5439: // <![CDATA[
                   5440: '.
                   5441:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5442:             &showhide_js()."\n".
1.549     raeburn  5443:             &toggleparmtextbox_js()."\n".
                   5444:             &validateparms_js()."\n".
                   5445:             &ipacc_boxes_js()."\n".
1.558     raeburn  5446:             &done_proctor_js()."\n".
1.588     raeburn  5447:             &deeplink_js()."\n".
1.523     raeburn  5448: '// ]]>
                   5449: </script>
                   5450: ';
1.549     raeburn  5451: 
1.523     raeburn  5452:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5453:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5454:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5455:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5456:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5457:     $r->print(<<ENDOVER);
1.549     raeburn  5458: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5459: ENDOVER
1.211     www      5460:     my @ids=();
                   5461:     my %typep=();
                   5462:     my %keyp=();
                   5463:     my %allparms=();
                   5464:     my %allparts=();
                   5465:     my %allmaps=();
                   5466:     my %mapp=();
                   5467:     my %symbp=();
                   5468:     my %maptitles=();
                   5469:     my %uris=();
                   5470:     my %keyorder=&standardkeyorder();
                   5471:     my %defkeytype=();
                   5472: 
                   5473:     my %alllevs=();
                   5474:     $alllevs{'Resource Level'}='full';
1.215     www      5475:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5476:     $alllevs{'Course Level'}='general';
                   5477: 
                   5478:     my $csec=$env{'form.csec'};
1.269     raeburn  5479:     my $cgroup=$env{'form.cgroup'};
1.211     www      5480: 
                   5481:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5482:     my $pschp=$env{'form.pschp'};
1.506     www      5483: 
1.211     www      5484:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5485:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5486: 
1.446     bisitz   5487:     my @selected_sections =
1.473     amueller 5488:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5489:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5490:     foreach my $sec (@selected_sections) {
                   5491:         if ($sec eq 'all') {
1.211     www      5492:             @selected_sections = ('all');
                   5493:         }
                   5494:     }
1.552     raeburn  5495:     if ($env{'request.course.sec'} ne '') {
                   5496:         @selected_sections = ($env{'request.course.sec'});
                   5497:     }
1.269     raeburn  5498:     my @selected_groups =
                   5499:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5500: 
                   5501:     my $pssymb='';
                   5502:     my $parmlev='';
1.446     bisitz   5503: 
1.211     www      5504:     unless ($env{'form.parmlev'}) {
                   5505:         $parmlev = 'map';
                   5506:     } else {
                   5507:         $parmlev = $env{'form.parmlev'};
                   5508:     }
                   5509: 
1.446     bisitz   5510:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5511:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5512:                 \%keyorder,\%defkeytype);
1.211     www      5513: 
1.374     albertel 5514:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5515:         @psprt = keys(%allparts);
1.374     albertel 5516:     }
1.211     www      5517: # Menu to select levels, etc
                   5518: 
1.456     bisitz   5519:     $r->print('<div class="LC_Box">');
1.445     neumanie 5520:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5521:     $r->print('<div>');
1.523     raeburn  5522:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5523:     &levelmenu($r,\%alllevs,$parmlev);
                   5524:     if ($parmlev ne 'general') {
1.447     bisitz   5525:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5526:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5527:     }
1.447     bisitz   5528:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5529:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5530:     $r->print('</div></div>');
1.446     bisitz   5531: 
1.456     bisitz   5532:     $r->print('<div class="LC_Box">');
1.452     bisitz   5533:     $r->print('<div>');
1.581     raeburn  5534:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5535:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5536:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5537:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5538:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5539:     $r->print('<table>'.
1.553     raeburn  5540:               '<tr><th>'.&mt('Parts').'</th>');
                   5541:     if ($sectionselector) {
                   5542:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5543:     }
                   5544:     if ($groupselector) {
                   5545:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5546:     }
                   5547:     $r->print('</tr><tr><td>');
1.211     www      5548:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5549:     $r->print('</td>');
                   5550:     if ($sectionselector) { 
                   5551:         $r->print('<td>'.$sectionselector.'</td>');
                   5552:     }
                   5553:     if ($groupselector) {
                   5554:         $r->print('<td>'.$groupselector.'</td>');
                   5555:     }
                   5556:     $r->print('</tr></table>');
1.447     bisitz   5557:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5558:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5559:     $r->print('</div></div>');
                   5560: 
1.456     bisitz   5561:     $r->print('<div class="LC_Box">');
1.452     bisitz   5562:     $r->print('<div>');
1.214     www      5563:     my $sortorder=$env{'form.sortorder'};
                   5564:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5565:     &sortmenu($r,$sortorder);
1.445     neumanie 5566:     $r->print('</div></div>');
1.446     bisitz   5567: 
1.214     www      5568:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5569: 
1.211     www      5570: # Build the list data hash from the specified parms
                   5571: 
                   5572:     my $listdata;
                   5573:     %{$listdata}=();
                   5574: 
                   5575:     foreach my $cat (@pscat) {
1.269     raeburn  5576:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5577:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5578:     }
                   5579: 
1.212     www      5580:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5581: 
1.481     amueller 5582:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5583: 
                   5584: # Read modified data
                   5585: 
1.481     amueller 5586:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5587: 
                   5588: # List data
                   5589: 
1.568     raeburn  5590:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5591:     }
                   5592:     $r->print(&tableend());
                   5593:     unless ($readonly) {
                   5594:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5595:     }
1.568     raeburn  5596:     $r->print('</form>');
1.507     www      5597:     &endSettingsScreen($r);
                   5598:     $r->print(&Apache::loncommon::end_page());
1.208     www      5599: }
                   5600: 
1.563     damieng  5601: # Fills $listdata with parameter information.
                   5602: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5603: # The non-type value is always 1.
                   5604: #
                   5605: # @param {string} $cat - parameter name
1.566     damieng  5606: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5607: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5608: # @param {hash reference} $listdata - the parameter data that will be modified
                   5609: # @param {array reference} $psprt - selected parts
                   5610: # @param {array reference} $selections - selected sections
                   5611: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5612: # @param {hash reference} $allmaps - hash map pc -> map src
                   5613: # @param {array reference} $ids - resource and map ids
                   5614: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5615: sub secgroup_lister {
                   5616:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5617:     foreach my $item (@{$selections}) {
                   5618:         foreach my $part (@{$psprt}) {
                   5619:             my $rootparmkey=$env{'request.course.id'};
                   5620:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5621:                 $rootparmkey.='.['.$item.']';
                   5622:             }
                   5623:             if ($parmlev eq 'general') {
                   5624: # course-level parameter
                   5625:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5626:                 $$listdata{$newparmkey}=1;
                   5627:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5628:             } elsif ($parmlev eq 'map') {
                   5629: # map-level parameter
1.548     raeburn  5630:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5631:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5632:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5633:                     $$listdata{$newparmkey}=1;
                   5634:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5635:                 }
                   5636:             } else {
                   5637: # resource-level parameter
                   5638:                 foreach my $rid (@{$ids}) {
                   5639:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5640:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5641:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5642:                     $$listdata{$newparmkey}=1;
                   5643:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5644:                 }
                   5645:             }
                   5646:         }
                   5647:     }
                   5648: }
                   5649: 
1.563     damieng  5650: # UI to edit parameter settings starting with a list of all existing parameters.
                   5651: # (called by setoverview action)
                   5652: #
                   5653: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5654: sub overview {
1.568     raeburn  5655:     my ($r,$parm_permission) = @_;
1.208     www      5656:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5657:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5658:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5659:     my $readonly = 1;
                   5660:     if ($parm_permission->{'edit'}) {
                   5661:         undef($readonly);
                   5662:     }
1.549     raeburn  5663:     my $js = '<script type="text/javascript">'."\n".
                   5664:              '// <![CDATA['."\n".
                   5665:              &toggleparmtextbox_js()."\n".
                   5666:              &validateparms_js()."\n".
                   5667:              &ipacc_boxes_js()."\n".
1.558     raeburn  5668:              &done_proctor_js()."\n".
1.588     raeburn  5669:              &deeplink_js()."\n".
1.549     raeburn  5670:              '// ]]>'."\n".
                   5671:              '</script>'."\n";
1.414     droeschl 5672:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5673:     text=>"Overview Mode"});
1.549     raeburn  5674:     my %loaditems = (
                   5675:                       'onload'   => "showHideLenient();",
                   5676:                     );
                   5677: 
                   5678:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5679:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5680:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5681:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5682:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5683: 
1.208     www      5684: # Store modified
                   5685: 
1.568     raeburn  5686:     unless ($readonly) {
                   5687:         &storedata($r,$crs,$dom);
                   5688:     }
1.208     www      5689: 
                   5690: # Read modified data
                   5691: 
1.552     raeburn  5692:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5693: 
1.214     www      5694: 
                   5695:     my $sortorder=$env{'form.sortorder'};
                   5696:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5697:     &sortmenu($r,$sortorder);
                   5698: 
1.568     raeburn  5699:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5700: 
                   5701:     if ($readonly) {
                   5702:         $r->print('<p>'.$submitbutton.'</p>');
                   5703:     }
                   5704: 
1.208     www      5705: # List data
                   5706: 
1.568     raeburn  5707:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5708:     $r->print(&tableend().'<p>');
                   5709:     if ($foundkeys) {
                   5710:         unless ($readonly) {
                   5711:             $r->print('<p>'.$submitbutton.'</p>');
                   5712:         }
                   5713:     } else {
                   5714:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5715:     }
                   5716:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5717: }
1.121     www      5718: 
1.560     damieng  5719: # Unused sub.
1.563     damieng  5720: #
                   5721: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5722: sub clean_parameters {
                   5723:     my ($r) = @_;
                   5724:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5725:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5726: 
1.414     droeschl 5727:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5728:         text=>"Clean Parameters"});
1.333     albertel 5729:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5730:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5731:     $r->print(<<ENDOVER);
                   5732: $start_page
                   5733: $breadcrumbs
                   5734: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5735: ENDOVER
                   5736: # Store modified
                   5737: 
                   5738:     &storedata($r,$crs,$dom);
                   5739: 
                   5740: # Read modified data
                   5741: 
                   5742:     my $resourcedata=&readdata($crs,$dom);
                   5743: 
                   5744: # List data
                   5745: 
                   5746:     $r->print('<h3>'.
1.473     amueller 5747:           &mt('These parameters refer to resources that do not exist.').
                   5748:           '</h3>'.
                   5749:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5750:           '<br />');
1.333     albertel 5751:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5752:           '<tr>'.
                   5753:           '<th>'.&mt('Delete').'</th>'.
                   5754:           '<th>'.&mt('Parameter').'</th>'.
                   5755:           '</tr>');
1.333     albertel 5756:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5757:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5758:             && $thiskey=~/\.type$/);
                   5759:         my %data = &parse_key($thiskey);
                   5760:         if (1) { #exists($data{'realm_exists'})
                   5761:             #&& !$data{'realm_exists'}) {
                   5762:             $r->print(&Apache::loncommon::start_data_table_row().
                   5763:                 '<tr>'.
                   5764:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5765: 
                   5766:             $r->print('<td>');
                   5767:             my $display_value = $resourcedata->{$thiskey};
                   5768:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5769:             $display_value =
                   5770:                 &Apache::lonlocal::locallocaltime($display_value);
                   5771:             }
1.470     raeburn  5772:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5773:             $parmitem = &mt($parmitem);
1.560     damieng  5774:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5775:                 $parmitem,$resourcedata->{$thiskey}));
                   5776:             $r->print('<br />');
                   5777:             if ($data{'scope_type'} eq 'all') {
                   5778:                 $r->print(&mt('All users'));
                   5779:             } elsif ($data{'scope_type'} eq 'user') {
                   5780:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581     raeburn  5781:             } elsif ($data{'scope_type'} eq 'secgroup') {
                   5782:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5783:             }
                   5784:             $r->print('<br />');
                   5785:             if ($data{'realm_type'} eq 'all') {
                   5786:                 $r->print(&mt('All Resources'));
                   5787:             } elsif ($data{'realm_type'} eq 'folder') {
                   5788:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5789:             } elsif ($data{'realm_type'} eq 'symb') {
                   5790:             my ($map,$resid,$url) =
                   5791:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5792:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5793:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5794:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5795:             }
                   5796:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5797:             $r->print('</td></tr>');
                   5798: 
1.473     amueller 5799:         }
1.333     albertel 5800:     }
                   5801:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5802:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5803:           '</p></form>');
                   5804:     &endSettingsScreen($r);
                   5805:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5806: }
                   5807: 
1.563     damieng  5808: # UI to shift all dates (called by dateshift1 action).
                   5809: # Used by overview mode.
                   5810: #
                   5811: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5812: sub date_shift_one {
                   5813:     my ($r) = @_;
                   5814:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5815:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5816:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5817: 
1.414     droeschl 5818:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5819:         text=>"Shifting Dates"});
1.390     www      5820:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5821:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5822:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5823:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5824:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5825:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5826:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5827:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5828:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5829:                                                         'timeshifted',
                   5830:                                                         $env{'form.timebase'},,
                   5831:                                                         '').
                   5832:               '</td></tr></table>'.
                   5833:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5834:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5835:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5836:     &endSettingsScreen($r);
1.390     www      5837:     $r->print(&Apache::loncommon::end_page());
                   5838: }
                   5839: 
1.563     damieng  5840: # UI to shift all dates (second form).
                   5841: #
                   5842: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5843: sub date_shift_two {
                   5844:     my ($r) = @_;
                   5845:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5846:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5847:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5848:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5849:         text=>"Shifting Dates"});
1.390     www      5850:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5851:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5852:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5853:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5854:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5855:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5856:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5857:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5858:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5859:     my $delta=$timeshifted-$env{'form.timebase'};
                   5860:     &dateshift($delta);
1.543     bisitz   5861:     $r->print(
                   5862:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5863:         '<br /><br />'.
                   5864:         &Apache::lonhtmlcommon::actionbox(
                   5865:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5866:     &endSettingsScreen($r);
1.390     www      5867:     $r->print(&Apache::loncommon::end_page());
                   5868: }
                   5869: 
1.563     damieng  5870: # Returns the different components of a resourcedata key.
                   5871: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5872: #       realm_exists, parameter_part, parameter_name.
                   5873: # Was used by clean_parameters (which is unused).
                   5874: #
                   5875: # @param {string} $key - the parameter key
                   5876: # @returns {hash}
1.333     albertel 5877: sub parse_key {
                   5878:     my ($key) = @_;
                   5879:     my %data;
                   5880:     my ($middle,$part,$name)=
1.572     damieng  5881:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5882:     $data{'scope_type'} = 'all';
                   5883:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5884:         $data{'scope'} = $1;
                   5885:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5886:             $data{'scope_type'} = 'user';
                   5887:             $data{'scope'} = [$1,$2];
                   5888:         } else {
1.581     raeburn  5889:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5890:         }
                   5891:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5892:     }
                   5893:     $middle=~s/\.+$//;
                   5894:     $middle=~s/^\.+//;
                   5895:     $data{'realm_type'}='all';
                   5896:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5897:         $data{'realm'} = $1;
                   5898:         $data{'realm_type'} = 'folder';
                   5899:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5900:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5901:     } elsif ($middle) {
1.560     damieng  5902:         $data{'realm'} = $middle;
                   5903:         $data{'realm_type'} = 'symb';
                   5904:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5905:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5906:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5907:     }
1.446     bisitz   5908: 
1.333     albertel 5909:     $data{'parameter_part'} = $part;
                   5910:     $data{'parameter_name'} = $name;
                   5911: 
                   5912:     return %data;
                   5913: }
                   5914: 
1.239     raeburn  5915: 
1.563     damieng  5916: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5917: sub header {
1.507     www      5918:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5919: }
1.193     albertel 5920: 
                   5921: 
                   5922: 
1.560     damieng  5923: ##################################################
                   5924: # MAIN MENU
                   5925: ##################################################
                   5926: 
1.563     damieng  5927: # Content and problem settings main menu.
                   5928: #
                   5929: # @param {Apache2::RequestRec} $r - the Apache request
                   5930: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5931: sub print_main_menu {
                   5932:     my ($r,$parm_permission)=@_;
                   5933:     #
1.414     droeschl 5934:     $r->print(&header());
1.507     www      5935:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5936:     my $crstype = &Apache::loncommon::course_type();
                   5937:     my $lc_crstype = lc($crstype);
                   5938: 
                   5939:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5940:     $r->print(<<ENDMAINFORMHEAD);
                   5941: <form method="post" enctype="multipart/form-data"
                   5942:       action="/adm/parmset" name="studentform">
                   5943: ENDMAINFORMHEAD
                   5944: #
1.195     albertel 5945:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5946:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5947:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5948:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5949:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  5950:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   5951:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  5952:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5953:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5954:                                         '/'.$env{'request.course.sec'});
                   5955:     }
1.568     raeburn  5956:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   5957:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   5958:                                         '/'.$env{'request.course.sec'});
                   5959:     }
                   5960:     my (%linktext,%linktitle,%url);
                   5961:     if ($parm_permission->{'edit'}) {
                   5962:         %linktext = (
                   5963:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   5964:                      settable        => 'Edit Resource Parameters - Table Mode',
                   5965:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   5966:                     );
                   5967:         %linktitle = (
                   5968:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   5969:                      settable        => 'Set/Modify resource parameters in table mode.',
                   5970:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   5971:                      );
                   5972:     } else {
                   5973:         %linktext = (
                   5974:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   5975:                      settable        => 'View Resource Parameters - Table Mode',
                   5976:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   5977:                    );
                   5978:         %linktitle = (
                   5979:                      newoverview     => 'Display resource parameters in overview mode.',
                   5980:                      settable        => 'Display resource parameters in table mode.',
                   5981:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   5982:                      );
                   5983:     }
                   5984:     if ($mgr) {
                   5985:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   5986:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   5987:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   5988:     } elsif ($vgr) {
                   5989:         $linktext{'resettimes'} = 'Display Student Access Times',
                   5990:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   5991:         $url{'resettimes'} = '/adm/accesstimes';
                   5992:     }
1.193     albertel 5993:     my @menu =
1.507     www      5994:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5995:         items => [
                   5996:           { linktext => 'Portfolio Metadata',
                   5997:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  5998:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  5999:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 6000:             icon =>'contact-new.png'   ,
                   6001:             },
1.568     raeburn  6002:           { linktext => $linktext{'resettimes'},
                   6003:             url => $url{'resettimes'},
                   6004:             permission => ($vgr || $mgr),
                   6005:             linktitle => $linktitle{'resettimes'},
                   6006:             icon => 'start-here.png',
1.473     amueller 6007:             },
1.520     raeburn  6008:           { linktext => 'Blocking Communication/Resource Access',
                   6009:             url => '/adm/setblock',
1.568     raeburn  6010:             permission => ($vcb || $dcm),
1.520     raeburn  6011:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   6012:             icon => 'comblock.png',
                   6013:             },
1.473     amueller 6014:           { linktext => 'Set Parameter Setting Default Actions',
                   6015:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  6016:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 6017:             linktitle =>'Set default actions for parameters.'  ,
                   6018:             icon => 'folder-new.png'  ,
                   6019:             }]},
                   6020:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   6021:         items => [
                   6022:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   6023:             url => '/adm/helper/parameter.helper',
1.568     raeburn  6024:             permission => $parm_permission->{'helper'},
1.473     amueller 6025:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   6026:             icon => 'dialog-information.png'  ,
                   6027:             #help => 'Parameter_Helper',
                   6028:             },
1.568     raeburn  6029:           { linktext => $linktext{'newoverview'},
1.473     amueller 6030:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  6031:             permission => $parm_permission->{'newoverview'},
                   6032:             linktitle => $linktitle{'newoverview'},
                   6033:             icon => 'edit-find.png',
1.473     amueller 6034:             #help => 'Parameter_Overview',
                   6035:             },
1.568     raeburn  6036:           { linktext => $linktext{'settable'},
1.473     amueller 6037:             url => '/adm/parmset?action=settable',
1.568     raeburn  6038:             permission => $parm_permission->{'settable'},
                   6039:             linktitle => $linktitle{'settable'},
                   6040:             icon => 'edit-copy.png',
1.473     amueller 6041:             #help => 'Table_Mode',
                   6042:             }]},
1.417     droeschl 6043:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 6044:          items => [
1.570     raeburn  6045:           { linktext => $linktext{'setoverview'},
1.473     amueller 6046:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  6047:             permission => $parm_permission->{'setoverview'},
                   6048:             linktitle => $linktitle{'setoverview'},
                   6049:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 6050:             #help => 'Parameter_Overview',
                   6051:             },
                   6052:           { linktext => 'Change Log',
                   6053:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  6054:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  6055:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 6056:             icon => 'document-properties.png',
1.473     amueller 6057:             }]}
1.193     albertel 6058:           );
1.414     droeschl 6059:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  6060:     $r->print('</form>');
1.507     www      6061:     &endSettingsScreen($r);
1.539     raeburn  6062:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 6063:     return;
                   6064: }
1.414     droeschl 6065: 
1.416     jms      6066: 
                   6067: 
1.560     damieng  6068: ##################################################
                   6069: # PORTFOLIO METADATA
                   6070: ##################################################
                   6071: 
1.563     damieng  6072: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   6073: # It looks like field titles are not localized.
                   6074: #
                   6075: # @param {Apache2::RequestRec} $r - the Apache request
                   6076: # @param {string} $field_name - metadata field name
                   6077: # @param {string} $field_text - metadata field title, in English unless manually added
                   6078: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 6079: sub output_row {
1.347     banghart 6080:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 6081:     my $output;
1.263     banghart 6082:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   6083:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 6084:     if (!defined($options)) {
1.254     banghart 6085:         $options = 'active,stuadd';
1.261     banghart 6086:         $values = '';
1.252     banghart 6087:     }
1.337     banghart 6088:     if (!($options =~ /deleted/)) {
                   6089:         my @options= ( ['active', 'Show to student'],
1.418     schafran 6090:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 6091:                     ['choices','Provide choices for students to select from']);
1.473     amueller 6092: #           ['onlyone','Student may select only one choice']);
1.337     banghart 6093:         if ($added_flag) {
                   6094:             push @options,['deleted', 'Delete Metadata Field'];
                   6095:         }
1.351     banghart 6096:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   6097:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 6098:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 6099:         foreach my $opt (@options) {
1.560     damieng  6100:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   6101:             $output .= &Apache::loncommon::continue_data_table_row();
                   6102:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   6103:                     <input type="checkbox" name="'.
                   6104:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   6105:                     &mt($opt->[1]).'</label></td>';
                   6106:             $output .= &Apache::loncommon::end_data_table_row();
                   6107:         }
1.351     banghart 6108:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   6109:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 6110:         $output .= &Apache::loncommon::end_data_table_row();
                   6111:         my $multiple_checked;
                   6112:         my $single_checked;
                   6113:         if ($options =~ m/onlyone/) {
1.422     bisitz   6114:             $multiple_checked = '';
1.423     bisitz   6115:             $single_checked = ' checked="checked"';
1.351     banghart 6116:         } else {
1.423     bisitz   6117:             $multiple_checked = ' checked="checked"';
1.422     bisitz   6118:             $single_checked = '';
1.351     banghart 6119:         }
1.560     damieng  6120:         $output .= &Apache::loncommon::continue_data_table_row();
                   6121:         $output .= '<td>'.('&nbsp;' x 10).'
                   6122:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   6123:                     '.&mt('Student may select multiple choices from list').'</td>';
                   6124:         $output .= &Apache::loncommon::end_data_table_row();
                   6125:         $output .= &Apache::loncommon::continue_data_table_row();
                   6126:         $output .= '<td>'.('&nbsp;' x 10).'
                   6127:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   6128:                     '.&mt('Student may select only one choice from list').'</td>';
                   6129:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 6130:     }
                   6131:     return ($output);
                   6132: }
1.416     jms      6133: 
                   6134: 
1.560     damieng  6135: # UI to order portfolio metadata fields.
1.563     damieng  6136: # Currently useless because addmetafield does not work.
                   6137: #
                   6138: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 6139: sub order_meta_fields {
                   6140:     my ($r)=@_;
                   6141:     my $idx = 1;
                   6142:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6143:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6144:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 6145:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  6146:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6147:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6148:         text=>"Add Metadata Field"});
1.560     damieng  6149:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6150:         {href=>"/adm/parmset?action=setrestrictmeta",
                   6151:         text=>"Restrict Metadata"},
                   6152:         {text=>"Order Metadata"});
1.345     banghart 6153:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  6154:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 6155:     if ($env{'form.storeorder'}) {
                   6156:         my $newpos = $env{'form.newpos'} - 1;
                   6157:         my $currentpos = $env{'form.currentpos'} - 1;
                   6158:         my @neworder = ();
1.548     raeburn  6159:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6160:         my $i;
1.341     banghart 6161:         if ($newpos > $currentpos) {
1.340     banghart 6162:         # moving stuff up
                   6163:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  6164:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6165:             }
                   6166:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  6167:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 6168:             }
                   6169:             $neworder[$newpos]=$oldorder[$currentpos];
                   6170:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  6171:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6172:             }
                   6173:         } else {
                   6174:         # moving stuff down
1.473     amueller 6175:             for ($i=0;$i<$newpos;$i++) {
                   6176:                 $neworder[$i]=$oldorder[$i];
                   6177:             }
                   6178:             $neworder[$newpos]=$oldorder[$currentpos];
                   6179:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   6180:                 $neworder[$i]=$oldorder[$i-1];
                   6181:             }
                   6182:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   6183:                 $neworder[$i]=$oldorder[$i];
                   6184:             }
1.340     banghart 6185:         }
1.560     damieng  6186:         my $ordered_fields = join ",", @neworder;
1.343     banghart 6187:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  6188:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6189:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 6190:     }
1.357     raeburn  6191:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 6192:     my $ordered_fields;
1.548     raeburn  6193:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6194:     if (!@fields_in_order) {
                   6195:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  6196:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 6197:             push @fields_in_order, $key;
1.341     banghart 6198:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 6199:         }
1.341     banghart 6200:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   6201:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6202:     }
1.340     banghart 6203:     $r->print('<table>');
                   6204:     my $num_fields = scalar(@fields_in_order);
                   6205:     foreach my $key (@fields_in_order) {
                   6206:         $r->print('<tr><td>');
                   6207:         $r->print('<form method="post" action="">');
1.537     bisitz   6208:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 6209:         for (my $i = 1;$i le $num_fields;$i ++) {
                   6210:             if ($i eq $idx) {
                   6211:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   6212:             } else {
                   6213:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   6214:             }
                   6215:         }
                   6216:         $r->print('</select></td><td>');
                   6217:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   6218:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   6219:         $r->print('</form>');
                   6220:         $r->print($$fields{$key}.'</td></tr>');
                   6221:         $idx ++;
                   6222:     }
                   6223:     $r->print('</table>');
1.507     www      6224:     &endSettingsScreen($r);
1.340     banghart 6225:     return 'ok';
                   6226: }
1.416     jms      6227: 
                   6228: 
1.563     damieng  6229: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   6230: # @returns {string}
1.359     banghart 6231: sub continue {
                   6232:     my $output;
                   6233:     $output .= '<form action="" method="post">';
                   6234:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
1.586     raeburn  6235:     $output .= '<input type="submit" value="'.&mt('Continue').'" />';
1.359     banghart 6236:     return ($output);
                   6237: }
1.416     jms      6238: 
                   6239: 
1.563     damieng  6240: # UI to add a metadata field.
                   6241: # Currenly does not work because of an HTML error (the field is not visible).
                   6242: #
                   6243: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 6244: sub addmetafield {
                   6245:     my ($r)=@_;
1.414     droeschl 6246:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6247:         text=>"Add Metadata Field"});
1.334     banghart 6248:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   6249:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 6250:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6251:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6252:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6253:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 6254:     if (exists($env{'form.undelete'})) {
1.358     banghart 6255:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 6256:         foreach my $meta_field(@meta_fields) {
                   6257:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   6258:             $options =~ s/deleted//;
                   6259:             $options =~ s/,,/,/;
                   6260:             my $put_result = &Apache::lonnet::put('environment',
                   6261:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   6262: 
1.586     raeburn  6263:             $r->print(&mt('Undeleted Metadata Field [_1] with result [_2]',
                   6264:                           '<strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}.
                   6265:                           '</strong>',$put_result).
                   6266:                       '<br />');
1.339     banghart 6267:         }
1.359     banghart 6268:         $r->print(&continue());
1.339     banghart 6269:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 6270:         my $meta_field = $env{'form.fieldname'};
                   6271:         my $display_field = $env{'form.fieldname'};
                   6272:         $meta_field =~ s/\W/_/g;
1.338     banghart 6273:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 6274:         my $put_result = &Apache::lonnet::put('environment',
                   6275:                             {'metadata.'.$meta_field.'.values'=>"",
                   6276:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   6277:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.586     raeburn  6278:         $r->print(&mt('Added new Metadata Field [_1] with result [_2]',
                   6279:                       '<strong>'.$env{'form.fieldname'}.'</strong>',$put_result).
                   6280:                   '<br />');
1.359     banghart 6281:         $r->print(&continue());
1.335     banghart 6282:     } else {
1.357     raeburn  6283:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 6284:         if ($fields) {
1.586     raeburn  6285:             $r->print(&mt('You may undelete previously deleted fields.').
                   6286:                       '<br />'.
                   6287:                       &mt('Check those you wish to undelete and click Undelete.').
                   6288:                       '<br />');
1.339     banghart 6289:             $r->print('<form method="post" action="">');
                   6290:             foreach my $key(keys(%$fields)) {
1.581     raeburn  6291:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 6292:             }
1.586     raeburn  6293:             $r->print('<input type="submit" name="undelete" value="'.&mt('Undelete').'" />');
1.339     banghart 6294:             $r->print('</form>');
                   6295:         }
1.586     raeburn  6296:         $r->print('<hr />'.
                   6297:                   &mt('[_1]Or[_2] you may enter a new metadata field name.',
                   6298:                       '<strong>','</strong>').
1.581     raeburn  6299:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 6300:         $r->print('<input type="text" name="fieldname" /><br />');
1.586     raeburn  6301:         $r->print('<input type="submit" value="'.&mt('Add Metadata Field').'" />');
1.581     raeburn  6302:         $r->print('</form>');
1.334     banghart 6303:     }
1.507     www      6304:     &endSettingsScreen($r);
1.334     banghart 6305: }
1.416     jms      6306: 
                   6307: 
                   6308: 
1.560     damieng  6309: # Display or save portfolio metadata.
1.563     damieng  6310: #
                   6311: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 6312: sub setrestrictmeta {
1.240     banghart 6313:     my ($r)=@_;
1.242     banghart 6314:     my $next_meta;
1.244     banghart 6315:     my $output;
1.245     banghart 6316:     my $item_num;
1.246     banghart 6317:     my $put_result;
1.414     droeschl 6318:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 6319:         text=>"Restrict Metadata"});
1.280     albertel 6320:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 6321:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 6322:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6323:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6324:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6325:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 6326:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 6327:     my $save_field = '';
1.586     raeburn  6328:     my %lt = &Apache::lonlocal::texthash(
                   6329:                                            addm => 'Add Metadata Field',
                   6330:                                            ordm => 'Order Metadata Fields',
                   6331:                                            save => 'Save',
                   6332:                                         );
1.259     banghart 6333:     if ($env{'form.restrictmeta'}) {
1.254     banghart 6334:         foreach my $field (sort(keys(%env))) {
1.252     banghart 6335:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 6336:                 my $options;
1.252     banghart 6337:                 my $meta_field = $1;
                   6338:                 my $meta_key = $2;
1.253     banghart 6339:                 if ($save_field ne $meta_field) {
1.252     banghart 6340:                     $save_field = $meta_field;
1.473     amueller 6341:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   6342:                         $options.='stuadd,';
                   6343:                     }
                   6344:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   6345:                         $options.='choices,';
                   6346:                     }
                   6347:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   6348:                         $options.='onlyone,';
                   6349:                     }
                   6350:                     if ($env{'form.'.$meta_field.'_active'}) {
                   6351:                         $options.='active,';
                   6352:                     }
                   6353:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   6354:                         $options.='deleted,';
                   6355:                     }
1.259     banghart 6356:                     my $name = $save_field;
1.560     damieng  6357:                     $put_result = &Apache::lonnet::put('environment',
                   6358:                         {'metadata.'.$meta_field.'.options'=>$options,
                   6359:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   6360:                         },$dom,$crs);
1.252     banghart 6361:                 }
                   6362:             }
                   6363:         }
                   6364:     }
1.296     albertel 6365:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 6366:                        {'freshen_cache' => 1});
1.335     banghart 6367:     # Get the default metadata fields
1.258     albertel 6368:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 6369:     # Now get possible added metadata fields
1.357     raeburn  6370:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.347     banghart 6371:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 6372:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 6373:         if ($field ne 'courserestricted') {
1.586     raeburn  6374:             $output.= &output_row($r,$field,$metadata_fields{$field});
1.560     damieng  6375:         }
1.255     banghart 6376:     }
1.351     banghart 6377:     my $buttons = (<<ENDButtons);
1.586     raeburn  6378:         <input type="submit" name="restrictmeta" value="$lt{'save'}" />
1.351     banghart 6379:         </form><br />
                   6380:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
1.586     raeburn  6381:         <input type="submit" name="restrictmeta" value="$lt{'addm'}" />
1.351     banghart 6382:         </form>
                   6383:         <br />
                   6384:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
1.586     raeburn  6385:         <input type="submit" name="restrictmeta" value="$lt{'ordm'}" />
1.351     banghart 6386: ENDButtons
1.337     banghart 6387:     my $added_flag = 1;
1.335     banghart 6388:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.586     raeburn  6389:         $output.= &output_row($r,$field,$$added_metadata_fields{$field},$added_flag);
1.335     banghart 6390:     }
1.347     banghart 6391:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   6392:     $r->print(<<ENDenv);
1.259     banghart 6393:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 6394:         $output
1.351     banghart 6395:         $buttons
1.340     banghart 6396:         </form>
1.244     banghart 6397: ENDenv
1.507     www      6398:     &endSettingsScreen($r);
1.280     albertel 6399:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 6400:     return 'ok';
                   6401: }
1.416     jms      6402: 
                   6403: 
1.563     damieng  6404: # Returns metadata fields that have been manually added.
                   6405: #
                   6406: # @param {string} $cid - course id
                   6407: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 6408: sub get_added_meta_fieldnames {
1.357     raeburn  6409:     my ($cid) = @_;
1.335     banghart 6410:     my %fields;
                   6411:     foreach my $key(%env) {
1.357     raeburn  6412:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 6413:             my $field_name = $1;
                   6414:             my ($display_field_name) = $env{$key};
                   6415:             $fields{$field_name} = $display_field_name;
                   6416:         }
                   6417:     }
                   6418:     return \%fields;
                   6419: }
1.416     jms      6420: 
                   6421: 
1.563     damieng  6422: # Returns metadata fields that have been manually added and deleted.
                   6423: #
                   6424: # @param {string} $cid - course id
                   6425: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 6426: sub get_deleted_meta_fieldnames {
1.357     raeburn  6427:     my ($cid) = @_;
1.339     banghart 6428:     my %fields;
                   6429:     foreach my $key(%env) {
1.357     raeburn  6430:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 6431:             my $field_name = $1;
                   6432:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   6433:                 my ($display_field_name) = $env{$key};
                   6434:                 $fields{$field_name} = $display_field_name;
                   6435:             }
                   6436:         }
                   6437:     }
                   6438:     return \%fields;
                   6439: }
1.560     damieng  6440: 
                   6441: 
                   6442: ##################################################
                   6443: # PARAMETER SETTINGS DEFAULT ACTIONS
                   6444: ##################################################
                   6445: 
                   6446: # UI to change parameter setting default actions
1.563     damieng  6447: #
                   6448: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6449: sub defaultsetter {
1.280     albertel 6450:     my ($r) = @_;
                   6451: 
1.414     droeschl 6452:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6453:         text=>"Set Defaults"});
1.531     raeburn  6454:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6455:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6456:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6457:     my $start_page =
1.531     raeburn  6458:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6459:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6460:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6461:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6462:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6463: 
1.221     www      6464:     my @ids=();
                   6465:     my %typep=();
                   6466:     my %keyp=();
                   6467:     my %allparms=();
                   6468:     my %allparts=();
                   6469:     my %allmaps=();
                   6470:     my %mapp=();
                   6471:     my %symbp=();
                   6472:     my %maptitles=();
                   6473:     my %uris=();
                   6474:     my %keyorder=&standardkeyorder();
                   6475:     my %defkeytype=();
                   6476: 
1.446     bisitz   6477:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6478:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6479:                 \%keyorder,\%defkeytype);
1.224     www      6480:     if ($env{'form.storerules'}) {
1.560     damieng  6481:         my %newrules=();
                   6482:         my @delrules=();
                   6483:         my %triggers=();
                   6484:         foreach my $key (keys(%env)) {
1.225     albertel 6485:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6486:                 my $tempkey=$1;
                   6487:                 my $action=$env{$key};
1.226     www      6488:                 if ($action) {
1.560     damieng  6489:                     $newrules{$tempkey.'_action'}=$action;
                   6490:                     if ($action ne 'default') {
                   6491:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6492:                         $triggers{$whichparm}.=$tempkey.':';
                   6493:                     }
                   6494:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6495:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6496:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6497:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6498:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6499:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6500:                     } else {
                   6501:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6502:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6503:                     }
                   6504:                 } else {
                   6505:                     push(@delrules,$tempkey.'_action');
                   6506:                     push(@delrules,$tempkey.'_type');
                   6507:                     push(@delrules,$tempkey.'_hours');
                   6508:                     push(@delrules,$tempkey.'_min');
                   6509:                     push(@delrules,$tempkey.'_sec');
                   6510:                     push(@delrules,$tempkey.'_value');
                   6511:                 }
1.473     amueller 6512:             }
                   6513:         }
1.560     damieng  6514:         foreach my $key (keys(%allparms)) {
                   6515:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6516:         }
1.560     damieng  6517:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6518:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6519:         &resetrulescache();
1.224     www      6520:     }
1.227     www      6521:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6522:                        'hours' => 'Hours',
                   6523:                        'min' => 'Minutes',
                   6524:                        'sec' => 'Seconds',
                   6525:                        'yes' => 'Yes',
                   6526:                        'no' => 'No');
1.222     www      6527:     my @standardoptions=('','default');
                   6528:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6529:     my @dateoptions=('','default');
                   6530:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6531:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6532:         unless ($tempkey) { next; }
                   6533:         push @standardoptions,'when_setting_'.$tempkey;
                   6534:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6535:         if (&isdateparm($defkeytype{$tempkey})) {
                   6536:             push @dateoptions,'later_than_'.$tempkey;
                   6537:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6538:             push @dateoptions,'earlier_than_'.$tempkey;
                   6539:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6540:         }
1.222     www      6541:     }
1.563     damieng  6542:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6543:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6544:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6545:           &Apache::loncommon::start_data_table_header_row().
                   6546:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6547:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6548:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6549:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6550:         unless ($tempkey) { next; }
                   6551:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6552:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6553:         my $action=&rulescache($tempkey.'_action');
                   6554:         $r->print('<select name="'.$tempkey.'_action">');
                   6555:         if (&isdateparm($defkeytype{$tempkey})) {
                   6556:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6557:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6558:             $r->print("\n<option value='$dateoptions[$i]'".
                   6559:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6560:                 ">$datedisplay[$i]</option>");
                   6561:             }
                   6562:         } else {
                   6563:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6564:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6565:             $r->print("\n<option value='$standardoptions[$i]'".
                   6566:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6567:                 ">$standarddisplay[$i]</option>");
                   6568:             }
1.473     amueller 6569:         }
1.560     damieng  6570:         $r->print('</select>');
                   6571:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6572:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6573:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6574:         }
1.560     damieng  6575:         $r->print("\n</td><td>\n");
1.222     www      6576: 
1.221     www      6577:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6578:             my $days=&rulescache($tempkey.'_days');
                   6579:             my $hours=&rulescache($tempkey.'_hours');
                   6580:             my $min=&rulescache($tempkey.'_min');
                   6581:             my $sec=&rulescache($tempkey.'_sec');
                   6582:             $r->print(<<ENDINPUTDATE);
                   6583:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6584:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6585:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6586:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6587: ENDINPUTDATE
1.560     damieng  6588:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6589:                 my $yeschecked='';
                   6590:                 my $nochecked='';
                   6591:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6592:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6593: 
                   6594:             $r->print(<<ENDYESNO);
                   6595:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6596:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6597: ENDYESNO
1.221     www      6598:         } else {
1.560     damieng  6599:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6600:         }
1.318     albertel 6601:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6602:     }
1.318     albertel 6603:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6604:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6605:           &mt('Save').'" /></form>'."\n");
                   6606:     &endSettingsScreen($r);
                   6607:     $r->print(&Apache::loncommon::end_page());
1.220     www      6608:     return;
                   6609: }
1.193     albertel 6610: 
1.560     damieng  6611: ##################################################
                   6612: # PARAMETER CHANGES LOG
                   6613: ##################################################
                   6614: 
1.563     damieng  6615: # Returns some info for a parameter log entry.
                   6616: # Returned entries:
                   6617: # $realm - HTML title for the parameter level and resource
                   6618: # $section - parameter section
                   6619: # $name - parameter name
                   6620: # $part - parameter part
                   6621: # $what - $part.'.'.$name
                   6622: # $middle - resource symb ?
                   6623: # $uname - user name (same as given)
                   6624: # $udom - user domain (same as given)
                   6625: # $issection - section or group name
                   6626: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6627: #
                   6628: # @param {string} $key - parameter log key
                   6629: # @param {string} $uname - user name
                   6630: # @param {string} $udom - user domain
                   6631: # @param {boolean} $typeflag - .type log entry
                   6632: # @returns {Array}
1.290     www      6633: sub components {
1.581     raeburn  6634:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6635: 
                   6636:     if ($typeflag) {
1.560     damieng  6637:         $key=~s/\.type$//;
1.290     www      6638:     }
1.330     albertel 6639: 
                   6640:     my ($middle,$part,$name)=
1.572     damieng  6641:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6642:     my $issection;
1.330     albertel 6643: 
1.290     www      6644:     my $section=&mt('All Students');
                   6645:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6646:         $issection=$1;
                   6647:         $section=&mt('Group/Section').': '.$issection;
                   6648:         $middle=~s/^\[(.*)\]//;
1.290     www      6649:     }
                   6650:     $middle=~s/\.+$//;
                   6651:     $middle=~s/^\.+//;
1.291     www      6652:     if ($uname) {
1.560     damieng  6653:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6654:         $issection='';
1.291     www      6655:     }
1.316     albertel 6656:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6657:     my $realmdescription=&mt('all resources');
1.556     raeburn  6658:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6659:         my $mapurl = $1;
                   6660:         my $maplevel = $2;
                   6661:         my $leveltitle = &mt('Folder/Map');
                   6662:         if ($maplevel eq 'rec') {
                   6663:             $leveltitle = &mt('Recursive');
                   6664:         }
1.560     damieng  6665:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6666:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6667:             $mapurl.')</span></span>';
                   6668:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6669:     } elsif ($middle) {
                   6670:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6671:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6672:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6673:             ' in '.$map.' id: '.$id.')</span></span>';
                   6674:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6675:     }
1.291     www      6676:     my $what=$part.'.'.$name;
1.330     albertel 6677:     return ($realm,$section,$name,$part,
1.473     amueller 6678:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6679: }
1.293     www      6680: 
1.563     damieng  6681: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6682: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6683: 
1.563     damieng  6684: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6685: sub load_parameter_names {
1.583     raeburn  6686:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 6687:     while (my $configline=<$config>) {
1.560     damieng  6688:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6689:         chomp($configline);
                   6690:         my ($short,$plain)=split(/:/,$configline);
                   6691:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6692:         if ($type eq 'display') {
                   6693:             $standard_parms{$name} = $plain;
1.469     raeburn  6694:         } elsif ($type eq 'type') {
1.560     damieng  6695:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6696:         }
1.328     albertel 6697:     }
                   6698:     close($config);
                   6699:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6700:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6701:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6702: }
                   6703: 
1.563     damieng  6704: # Returns a parameter title for standard parameters, the name for others.
                   6705: #
                   6706: # @param {string} $name - parameter name
                   6707: # @returns {string}
1.292     www      6708: sub standard_parameter_names {
                   6709:     my ($name)=@_;
1.328     albertel 6710:     if (!%standard_parms) {
1.560     damieng  6711:         &load_parameter_names();
1.328     albertel 6712:     }
1.292     www      6713:     if ($standard_parms{$name}) {
1.560     damieng  6714:         return $standard_parms{$name};
1.446     bisitz   6715:     } else {
1.560     damieng  6716:         return $name;
1.292     www      6717:     }
                   6718: }
1.290     www      6719: 
1.563     damieng  6720: # Returns a parameter type for standard parameters, undef for others.
                   6721: #
                   6722: # @param {string} $name - parameter name
                   6723: # @returns {string}
1.469     raeburn  6724: sub standard_parameter_types {
                   6725:     my ($name)=@_;
                   6726:     if (!%standard_parms_types) {
                   6727:         &load_parameter_names();
                   6728:     }
                   6729:     if ($standard_parms_types{$name}) {
                   6730:         return $standard_parms_types{$name};
                   6731:     }
                   6732:     return;
                   6733: }
1.309     www      6734: 
1.563     damieng  6735: # Returns a parameter level title (not localized) from the parameter level name.
                   6736: #
                   6737: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6738: # @returns {string}
1.557     raeburn  6739: sub standard_parameter_levels {
                   6740:     my ($name)=@_;
                   6741:     my %levels = (
                   6742:                     'resourcelevel'   => 'a single resource',
                   6743:                     'maplevel'        => 'the enclosing map/folder', 
                   6744:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6745:                     'courselevel'     => 'the general (course) level',
                   6746:                  );
                   6747:     if ($levels{$name}) {
                   6748:         return $levels{$name};
                   6749:     }
                   6750:     return;
                   6751: }
                   6752: 
1.560     damieng  6753: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6754: #
                   6755: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6756: sub parm_change_log {
1.568     raeburn  6757:     my ($r,$parm_permission)=@_;
1.531     raeburn  6758:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6759:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6760:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6761:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6762:     text=>"Parameter Change Log"});
1.522     raeburn  6763:     my $js = '<script type="text/javascript">'."\n".
                   6764:              '// <![CDATA['."\n".
                   6765:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6766:              '// ]]>'."\n".
                   6767:              '</script>'."\n";
                   6768:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6769:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6770:     &startSettingsScreen($r,'parmset',$crstype);
                   6771:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6772: 
1.301     www      6773:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6774: 
1.522     raeburn  6775:     $r->print('<div class="LC_left_float">'.
                   6776:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6777:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6778:                      method="post" name="parameterlog">');
1.446     bisitz   6779: 
1.311     albertel 6780:     my %saveable_parameters = ('show' => 'scalar',);
                   6781:     &Apache::loncommon::store_course_settings('parameter_log',
                   6782:                                               \%saveable_parameters);
                   6783:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6784:                                                 \%saveable_parameters);
1.522     raeburn  6785:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6786:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6787:               '</form></fieldset></div><br clear="all" />');
1.301     www      6788: 
1.568     raeburn  6789:     my $readonly = 1;
                   6790:     if ($parm_permission->{'edit'}) {
                   6791:         undef($readonly);
                   6792:     }
1.531     raeburn  6793:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6794:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6795:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6796:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6797:     unless ($readonly) {
                   6798:         $r->print('<th>'.&mt('Announce').'</th>');
                   6799:     }
                   6800:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6801:     my $shown=0;
1.349     www      6802:     my $folder='';
                   6803:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6804:         my $last='';
                   6805:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6806:                 &GDBM_READER(),0640)) {
                   6807:             $last=$hash{'last_known'};
                   6808:             untie(%hash);
                   6809:         }
                   6810:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6811:     }
                   6812:     foreach my $id (sort {
                   6813:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6814:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6815:                 }
                   6816:                 my $aid = (split('00000',$a))[-1];
                   6817:                 my $bid = (split('00000',$b))[-1];
                   6818:                 return $bid<=>$aid;
1.473     amueller 6819:             } (keys(%parmlog))) {
1.294     www      6820:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6821:         my $count = 0;
                   6822:         my $time =
                   6823:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6824:         my $plainname =
                   6825:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6826:                         $parmlog{$id}{'exe_udom'});
                   6827:         my $about_me_link =
                   6828:             &Apache::loncommon::aboutmewrapper($plainname,
                   6829:                             $parmlog{$id}{'exe_uname'},
                   6830:                             $parmlog{$id}{'exe_udom'});
                   6831:         my $send_msg_link='';
1.568     raeburn  6832:         if ((!$readonly) && 
                   6833:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6834:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6835:             $send_msg_link ='<br />'.
                   6836:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6837:                             $parmlog{$id}{'exe_uname'},
                   6838:                             $parmlog{$id}{'exe_udom'});
                   6839:         }
                   6840:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6841:         my $makenewrow=0;
                   6842:         my %istype=();
                   6843:         my $output;
                   6844:         foreach my $changed (reverse(sort(@changes))) {
                   6845:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6846:             my $typeflag = ($changed =~/\.type$/ &&
                   6847:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6848:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581     raeburn  6849:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6850:             if ($env{'request.course.sec'} ne '') {
                   6851:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6852:                 if ($uname ne '') {
                   6853:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6854:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6855:                 }
                   6856:             }
                   6857:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6858:                 if ($folder) {
                   6859:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6860:                 }
                   6861:             }
                   6862:             if ($typeflag) {
                   6863:                 $istype{$parmname}=$value;
                   6864:                 if (!$env{'form.includetypes'}) { next; }
                   6865:             }
                   6866:             $count++;
                   6867:             if ($makenewrow) {
                   6868:                 $output .= $row_start;
                   6869:             } else {
                   6870:                 $makenewrow=1;
                   6871:             }
1.470     raeburn  6872:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6873:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6874:                 &mt($parmitem).'</td><td>'.
                   6875:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6876:             my $stillactive=0;
                   6877:             if ($parmlog{$id}{'delflag'}) {
                   6878:                 $output .= &mt('Deleted');
                   6879:             } else {
                   6880:                 if ($typeflag) {
1.470     raeburn  6881:                     my $parmitem = &standard_parameter_names($value); 
                   6882:                     $parmitem = &mt($parmitem);
1.560     damieng  6883:                     $output .= &mt('Type: [_1]',$parmitem);
                   6884:                 } else {
1.584     raeburn  6885:                     my $toolsymb;
                   6886:                     if ($middle =~ /ext\.tool$/) {
                   6887:                         $toolsymb = $middle;
                   6888:                     }
1.560     damieng  6889:                     my ($level,@all)=&parmval_by_symb($what,$middle,
1.584     raeburn  6890:                         &Apache::lonnet::metadata($middle,$what,$toolsymb),
1.560     damieng  6891:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6892:                     my $showvalue = $value;
                   6893:                     if ($istype{$parmname} eq '') {
                   6894:                         my $type = &standard_parameter_types($parmname);
                   6895:                         if ($type ne '') {
                   6896:                             if (&isdateparm($type)) {
                   6897:                                 $showvalue =
                   6898:                                     &Apache::lonlocal::locallocaltime($value);
                   6899:                             }
                   6900:                         }
                   6901:                     } else {
1.560     damieng  6902:                         if (&isdateparm($istype{$parmname})) {
                   6903:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6904:                         }
1.469     raeburn  6905:                     }
                   6906:                     $output .= $showvalue;
1.560     damieng  6907:                     if ($value ne $all[$level]) {
                   6908:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6909:                     } else {
                   6910:                         $stillactive=1;
                   6911:                     }
                   6912:                 }
1.473     amueller 6913:             }
1.568     raeburn  6914:             $output .= '</td>';
                   6915: 
                   6916:             unless ($readonly) { 
                   6917:                 $output .= '<td>';
                   6918:                 if ($stillactive) {
                   6919:                     my $parmitem = &standard_parameter_names($parmname);
                   6920:                     $parmitem = &mt($parmitem);
                   6921:                     my $title=&mt('Changed [_1]',$parmitem);
                   6922:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   6923:                         $parmitem,$realmdescription,
                   6924:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   6925:                     if (($uname) && ($udom)) {
                   6926:                         $output .=
                   6927:                         &Apache::loncommon::messagewrapper('Notify User',
                   6928:                                                            $uname,$udom,$title,
                   6929:                                                            $description);
                   6930:                     } else {
                   6931:                         $output .=
                   6932:                             &Apache::lonrss::course_blog_link($id,$title,
                   6933:                                                               $description);
                   6934:                     }
1.560     damieng  6935:                 }
1.568     raeburn  6936:                 $output .= '</td>';
1.560     damieng  6937:             }
1.568     raeburn  6938:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 6939:         }
1.560     damieng  6940:         if ($env{'form.displayfilter'} eq 'containing') {
                   6941:             my $wholeentry=$about_me_link.':'.
                   6942:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6943:             $output;
                   6944:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6945:         }
1.349     www      6946:         if ($count) {
1.560     damieng  6947:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6948:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6949:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6950:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6951:             $send_msg_link.'</td>'.$output);
                   6952:             $shown++;
                   6953:         }
                   6954:         if (!($env{'form.show'} eq &mt('all')
                   6955:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6956:     }
1.301     www      6957:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6958:     &endSettingsScreen($r);
1.284     www      6959:     $r->print(&Apache::loncommon::end_page());
                   6960: }
                   6961: 
1.560     damieng  6962: ##################################################
                   6963: # MISC !
                   6964: ##################################################
                   6965: 
1.563     damieng  6966: # Stores slot information.
1.560     damieng  6967: # Used by table UI
1.563     damieng  6968: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6969: #
                   6970: # @param {string} $slot_name - slot name
                   6971: # @param {string} $cdom - course domain
                   6972: # @param {string} $cnum - course number
                   6973: # @param {string} $symb - resource symb
                   6974: # @param {string} $uname - user name
                   6975: # @param {string} $udom - user domain
                   6976: # @returns {string} - 'ok' or error name
1.437     raeburn  6977: sub update_slots {
                   6978:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6979:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6980:     if (!keys(%slot)) {
                   6981:         return 'error: slot does not exist';
                   6982:     }
                   6983:     my $max=$slot{'maxspace'};
                   6984:     if (!defined($max)) { $max=99999; }
                   6985: 
                   6986:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6987:                                        "^$slot_name\0");
                   6988:     my ($tmp)=%consumed;
                   6989:     if ($tmp=~/^error: 2 / ) {
                   6990:         return 'error: unable to determine current slot status';
                   6991:     }
                   6992:     my $last=0;
                   6993:     foreach my $key (keys(%consumed)) {
                   6994:         my $num=(split('\0',$key))[1];
                   6995:         if ($num > $last) { $last=$num; }
                   6996:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6997:             return 'ok';
                   6998:         }
                   6999:     }
                   7000: 
                   7001:     if (scalar(keys(%consumed)) >= $max) {
                   7002:         return 'error: no space left in slot';
                   7003:     }
                   7004:     my $wanted=$last+1;
                   7005: 
                   7006:     my %reservation=('name'      => $uname.':'.$udom,
                   7007:                      'timestamp' => time,
                   7008:                      'symb'      => $symb);
                   7009: 
                   7010:     my $success=&Apache::lonnet::newput('slot_reservations',
                   7011:                                         {"$slot_name\0$wanted" =>
                   7012:                                              \%reservation},
                   7013:                                         $cdom, $cnum);
1.438     raeburn  7014:     if ($success eq 'ok') {
                   7015:         my %storehash = (
                   7016:                           symb    => $symb,
                   7017:                           slot    => $slot_name,
                   7018:                           action  => 'reserve',
                   7019:                           context => 'parameter',
                   7020:                         );
1.526     raeburn  7021:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7022:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  7023: 
1.526     raeburn  7024:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7025:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  7026:     }
1.437     raeburn  7027:     return $success;
                   7028: }
                   7029: 
1.563     damieng  7030: # Deletes a slot reservation.
1.560     damieng  7031: # Used by table UI
1.563     damieng  7032: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   7033: #
                   7034: # @param {string} $slot_name - slot name
                   7035: # @param {string} $cdom - course domain
                   7036: # @param {string} $cnum - course number
                   7037: # @param {string} $uname - user name
                   7038: # @param {string} $udom - user domain
                   7039: # @param {string} $symb - resource symb
                   7040: # @returns {string} - 'ok' or error name
1.437     raeburn  7041: sub delete_slots {
                   7042:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   7043:     my $delresult;
                   7044:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   7045:                                          $cnum, "^$slot_name\0");
                   7046:     if (&Apache::lonnet::error(%consumed)) {
                   7047:         return 'error: unable to determine current slot status';
                   7048:     }
                   7049:     my ($tmp)=%consumed;
                   7050:     if ($tmp=~/^error: 2 /) {
                   7051:         return 'error: unable to determine current slot status';
                   7052:     }
                   7053:     foreach my $key (keys(%consumed)) {
                   7054:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   7055:             my $num=(split('\0',$key))[1];
                   7056:             my $entry = $slot_name.'\0'.$num;
                   7057:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   7058:                                               $cdom,$cnum);
                   7059:             if ($delresult eq 'ok') {
                   7060:                 my %storehash = (
                   7061:                                   symb    => $symb,
                   7062:                                   slot    => $slot_name,
                   7063:                                   action  => 'release',
                   7064:                                   context => 'parameter',
                   7065:                                 );
1.526     raeburn  7066:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7067:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  7068:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7069:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  7070:             }
                   7071:         }
                   7072:     }
                   7073:     return $delresult;
                   7074: }
                   7075: 
1.563     damieng  7076: # Returns true if there is a current course.
1.560     damieng  7077: # Used by handler
1.563     damieng  7078: #
                   7079: # @returns {boolean}
1.355     albertel 7080: sub check_for_course_info {
                   7081:     my $navmap = Apache::lonnavmaps::navmap->new();
                   7082:     return 1 if ($navmap);
                   7083:     return 0;
                   7084: }
                   7085: 
1.563     damieng  7086: # Returns the current course host and host LON-CAPA version.
                   7087: #
                   7088: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  7089: sub parameter_release_vars { 
1.504     raeburn  7090:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7091:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   7092:    my $chostname = &Apache::lonnet::hostname($chome);
                   7093:    my ($cmajor,$cminor) = 
                   7094:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   7095:    return ($chostname,$cmajor,$cminor);
                   7096: }
                   7097: 
1.563     damieng  7098: # Checks if the course host version can handle a parameter required version,
                   7099: # and if it does, stores the release needed for the course.
                   7100: #
                   7101: # @param {string} $name - parameter name
                   7102: # @param {string} $value - parameter value
                   7103: # @param {string} $valmatch - name of the test used for checking the value
                   7104: # @param {string} $namematch - name of the test used for checking the name
                   7105: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   7106: # @param {integer} $cmajor - course major version number
                   7107: # @param {integer} $cminor - course minor version number
                   7108: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  7109: sub parameter_releasecheck {
1.557     raeburn  7110:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  7111:     my $needsnewer;
                   7112:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   7113:     if (($cmajor < $needsmajor) || 
                   7114:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   7115:         $needsnewer = 1;
1.557     raeburn  7116:     } elsif ($name) {
                   7117:         if ($valmatch) {
                   7118:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   7119:         } elsif ($value) { 
                   7120:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   7121:         }
                   7122:     } elsif ($namematch) {
                   7123:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  7124:     }
                   7125:     return $needsnewer;
                   7126: }
                   7127: 
1.568     raeburn  7128: sub get_permission {
                   7129:     my %permission;
                   7130:     my $allowed = 0;
                   7131:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   7132:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   7133:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   7134:                   $env{'request.course.sec'}))) {
                   7135:         %permission= (
                   7136:                        'edit'               => 1,
                   7137:                        'set'                => 1,
                   7138:                        'setoverview'        => 1,
                   7139:                        'addmetadata'        => 1,
                   7140:                        'ordermetadata'      => 1,
                   7141:                        'setrestrictmeta'    => 1,
                   7142:                        'newoverview'        => 1,
                   7143:                        'setdefaults'        => 1,
                   7144:                        'settable'           => 1,
                   7145:                        'parameterchangelog' => 1,
                   7146:                        'cleanparameters'    => 1,
                   7147:                        'dateshift1'         => 1,
                   7148:                        'dateshift2'         => 1,
                   7149:                        'helper'             => 1,
                   7150:          );
                   7151:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   7152:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   7153:                   $env{'request.course.sec'}))) {
                   7154:         %permission = (
                   7155:                        'set'                => 1,
                   7156:                        'settable'           => 1,
                   7157:                        'newoverview'        => 1,
                   7158:                        'setoverview'        => 1,
                   7159:                        'parameterchangelog' => 1,
                   7160:                       );
                   7161:     }
                   7162:     foreach my $perm (values(%permission)) {
                   7163:         if ($perm) { $allowed=1; last; }
                   7164:     }
                   7165:     return (\%permission,$allowed);
                   7166: }
                   7167: 
1.560     damieng  7168: ##################################################
                   7169: # HANDLER
                   7170: ##################################################
                   7171: 
                   7172: # Main handler for lonparmset.
                   7173: # Sub called based on request parameters action and command:
                   7174: # no command or action: print_main_menu
                   7175: # command 'set': assessparms (direct access to table mode for a resource)
                   7176: #                (this can also be accessed simply with the symb parameter)
                   7177: # action 'setoverview': overview (display all existing parameter settings)
                   7178: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   7179: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   7180: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   7181: # action 'newoverview': newoverview (overview mode)
                   7182: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   7183: # action 'settable': assessparms (table mode)
                   7184: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   7185: #                              blog postings, user notification changes)
                   7186: # action 'cleanparameters': clean_parameters (unused)
                   7187: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   7188: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      7189: sub handler {
1.43      albertel 7190:     my $r=shift;
1.30      www      7191: 
1.376     albertel 7192:     &reset_caches();
                   7193: 
1.414     droeschl 7194:     &Apache::loncommon::content_type($r,'text/html');
                   7195:     $r->send_http_header;
                   7196:     return OK if $r->header_only;
                   7197: 
1.193     albertel 7198:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 7199:                         ['action','state',
1.205     www      7200:                                              'pres_marker',
                   7201:                                              'pres_value',
1.206     www      7202:                                              'pres_type',
1.506     www      7203:                                              'filter','part',
1.390     www      7204:                                              'udom','uname','symb','serial','timebase']);
1.131     www      7205: 
1.83      bowersj2 7206: 
1.193     albertel 7207:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 7208:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      7209:                         text=>"Content and Problem Settings",
1.473     amueller 7210:                         faq=>10,
                   7211:                         bug=>'Instructor Interface',
1.442     droeschl 7212:                                             help =>
                   7213:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      7214: 
1.30      www      7215: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  7216:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 7217:     my $exists = &check_for_course_info();
                   7218: 
1.568     raeburn  7219:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 7220:         #
                   7221:         # Main switch on form.action and form.state, as appropriate
                   7222:         #
                   7223:         # Check first if coming from someone else headed directly for
                   7224:         #  the table mode
1.568     raeburn  7225:         if (($parm_permission->{'set'}) && 
                   7226:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   7227:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   7228:             &assessparms($r,$parm_permission);
1.193     albertel 7229:         } elsif (! exists($env{'form.action'})) {
                   7230:             &print_main_menu($r,$parm_permission);
1.568     raeburn  7231:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   7232:             &print_main_menu($r,$parm_permission);
1.414     droeschl 7233:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  7234:             &overview($r,$parm_permission);
1.560     damieng  7235:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   7236:             &addmetafield($r);
                   7237:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   7238:             &order_meta_fields($r);
1.414     droeschl 7239:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  7240:             &setrestrictmeta($r);
1.414     droeschl 7241:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  7242:             &newoverview($r,$parm_permission);
1.414     droeschl 7243:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  7244:             &defaultsetter($r);
                   7245:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  7246:             &assessparms($r,$parm_permission);
1.414     droeschl 7247:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  7248:             &parm_change_log($r,$parm_permission);
1.414     droeschl 7249:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  7250:             &clean_parameters($r);
1.414     droeschl 7251:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      7252:             &date_shift_one($r);
1.414     droeschl 7253:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      7254:             &date_shift_two($r);
1.446     bisitz   7255:         }
1.43      albertel 7256:     } else {
1.1       www      7257: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  7258:         if ($exists) {
                   7259:             $env{'user.error.msg'}=
                   7260:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   7261:         } else {
                   7262:             $env{'user.error.msg'}=
                   7263:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   7264:         }
                   7265:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 7266:     }
1.376     albertel 7267:     &reset_caches();
                   7268: 
1.43      albertel 7269:     return OK;
1.1       www      7270: }
                   7271: 
                   7272: 1;
                   7273: __END__
                   7274: 
                   7275: 

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