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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.589   ! raeburn     4: # $Id: lonparmset.pm,v 1.588 2019/01/06 15:27:48 raeburn Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
1.579     raeburn    39: lonparmset provides an interface to setting content parameters in a 
                     40: course.
1.560     damieng    41: 
                     42: It contains all the code for the "Content and Problem Settings" UI, except
                     43: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
                     44: and lonblockingmenu.pm.
1.59      matthew    45: 
                     46: =head1 DESCRIPTION
                     47: 
                     48: This module sets coursewide and assessment parameters.
                     49: 
                     50: =head1 INTERNAL SUBROUTINES
                     51: 
1.416     jms        52: =over
1.59      matthew    53: 
1.416     jms        54: =item parmval()
1.59      matthew    55: 
                     56: Figure out a cascading parameter.
                     57: 
1.71      albertel   58: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   59:          $id   - a bighash Id number
1.71      albertel   60:          $def  - the resource's default value   'stupid emacs
                     61: 
1.556     raeburn    62: Returns:  A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71      albertel   63: 
1.556     raeburn    64: 18 - General Course
                     65: 17 - Map or Folder level in course (recursive) 
                     66: 16 - Map or Folder level in course (non-recursive)
                     67: 15 - resource default
                     68: 14 - map default
                     69: 13 - resource level in course
                     70: 12 - General for section
                     71: 11 - Map or Folder level for section (recursive)
                     72: 10 - Map or Folder level for section (non-recursive)
                     73: 9 - resource level in section
                     74: 8 - General for group
                     75: 7 - Map or Folder level for group (recursive)
                     76: 6 - Map or Folder level for group (non-recursive)
                     77: 5 - resource level in group
                     78: 4 - General for specific student
                     79: 3 - Map or Folder level for specific student (recursive)
                     80: 2 - Map or Folder level for specific student (non-recursive)
1.71      albertel   81: 1 - resource level for specific student
1.2       www        82: 
1.416     jms        83: =item parmval_by_symb()
                     84: 
                     85: =item reset_caches()
                     86: 
                     87: =item cacheparmhash() 
                     88: 
                     89: =item parmhash()
                     90: 
                     91: =item symbcache()
                     92: 
                     93: =item preset_defaults()
                     94: 
                     95: =item date_sanity_info()
                     96: 
                     97: =item storeparm()
                     98: 
                     99: Store a parameter by symb
                    100: 
                    101:     Takes
                    102:     - symb
                    103:     - name of parameter
                    104:     - level
                    105:     - new value
                    106:     - new type
                    107:     - username
                    108:     - userdomain
                    109: 
                    110: =item log_parmset()
                    111: 
                    112: =item storeparm_by_symb_inner()
                    113: 
                    114: =item valout()
                    115: 
                    116: Format a value for output.
                    117: 
                    118: Inputs:  $value, $type, $editable
                    119: 
                    120: Returns: $value, formatted for output.  If $type indicates it is a date,
                    121: localtime($value) is returned.
                    122: $editable will return an icon to click on
                    123: 
                    124: =item plink()
                    125: 
                    126: Produces a link anchor.
                    127: 
                    128: Inputs: $type,$dis,$value,$marker,$return,$call
                    129: 
                    130: Returns: scalar with html code for a link which will envoke the 
                    131: javascript function 'pjump'.
                    132: 
                    133: =item page_js()
                    134: 
                    135: =item startpage()
                    136: 
                    137: =item print_row()
                    138: 
                    139: =item print_td()
                    140: 
1.580     raeburn   141: =item check_other_groups()
1.416     jms       142: 
                    143: =item parm_control_group()
                    144: 
                    145: =item extractResourceInformation() : 
                    146: 
1.512     foxr      147:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       148: 
1.542     raeburn   149: Input: See list below
                    150: 
                    151: =over 4
1.416     jms       152: 
1.512     foxr      153: =item * B<env{'user.name'}> : Current username
1.416     jms       154: 
1.512     foxr      155: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       156: 
1.542     raeburn   157: =item * B<env{"request.course.fn"}> : Course
                    158: 
                    159: =back
1.416     jms       160: 
1.512     foxr      161: Outputs: See list below:
1.416     jms       162: 
1.542     raeburn   163: =over 4
                    164: 
1.512     foxr      165: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       166: 
1.512     foxr      167: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416     jms       168: 
1.512     foxr      169: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416     jms       170: 
1.512     foxr      171: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       172: 
1.512     foxr      173: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    174: 
                    175: =item * B<allmaps> (out) : hash, ???
1.416     jms       176: 
                    177: =item * B<mapp> : ??
                    178: 
                    179: =item * B<symbp> : hash, id->full sym?
                    180: 
1.512     foxr      181: =item * B<maptitles>
                    182: 
                    183: =item * B<uris>
1.416     jms       184: 
1.512     foxr      185: =item * B<keyorder>
                    186: 
                    187: =item * B<defkeytype>
1.416     jms       188: 
1.542     raeburn   189: =back
                    190: 
1.416     jms       191: =item isdateparm()
                    192: 
                    193: =item parmmenu()
                    194: 
                    195: =item partmenu()
                    196: 
                    197: =item usermenu()
                    198: 
                    199: =item displaymenu()
                    200: 
                    201: =item mapmenu()
                    202: 
                    203: =item levelmenu()
                    204: 
                    205: =item sectionmenu()
                    206: 
                    207: =item keysplit()
                    208: 
                    209: =item keysinorder()
                    210: 
                    211: =item keysinorder_bytype()
                    212: 
                    213: =item keysindisplayorder()
                    214: 
                    215: =item standardkeyorder()
                    216: 
                    217: =item assessparms() : 
                    218: 
                    219: Show assessment data and parameters.  This is a large routine that should
                    220: be simplified and shortened... someday.
                    221: 
1.513     foxr      222: Inputs: $r - the Apache request object.
                    223:   
1.416     jms       224: Returns: nothing
                    225: 
                    226: Variables used (guessed by Jeremy):
                    227: 
1.542     raeburn   228: =over
                    229: 
1.416     jms       230: =item * B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
                    231: 
                    232: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    233: 
                    234: =item * B<@catmarker> contains list of all possible parameters including part #s
                    235: 
                    236: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    237: 
                    238: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    239:         When storing information, store as part 0
                    240:         When requesting information, request from full part
                    241: 
1.542     raeburn   242: =back
                    243: 
1.416     jms       244: =item tablestart()
                    245: 
                    246: =item tableend()
                    247: 
                    248: =item extractuser()
                    249: 
                    250: =item parse_listdata_key()
                    251: 
                    252: =item listdata()
                    253: 
                    254: =item date_interval_selector()
                    255: 
                    256: =item get_date_interval_from_form()
                    257: 
                    258: =item default_selector()
                    259: 
                    260: =item string_selector()
                    261: 
                    262: =item dateshift()
                    263: 
                    264: =item newoverview()
                    265: 
                    266: =item secgroup_lister()
                    267: 
                    268: =item overview()
                    269: 
                    270: =item clean_parameters()
                    271: 
                    272: =item date_shift_one()
                    273: 
                    274: =item date_shift_two()
                    275: 
                    276: =item parse_key()
                    277: 
                    278: =item header()
                    279: 
                    280: Output html header for page
                    281: 
                    282: =item print_main_menu()
                    283: 
                    284: =item output_row()
                    285: 
                    286: Set portfolio metadata
                    287: 
                    288: =item order_meta_fields()
                    289: 
                    290: =item addmetafield()
                    291: 
                    292: =item setrestrictmeta()
                    293: 
                    294: =item get_added_meta_fieldnames()
                    295: 
                    296: =item get_deleted_meta_fieldnames()
                    297: 
                    298: =item defaultsetter()
                    299: 
                    300: =item components()
                    301: 
                    302: =item load_parameter_names()
                    303: 
                    304: =item parm_change_log()
                    305: 
                    306: =item handler() : 
                    307: 
1.450     raeburn   308: Main handler.  Calls &assessparms subroutine.
1.416     jms       309: 
                    310: =back
                    311: 
1.59      matthew   312: =cut
                    313: 
1.416     jms       314: ###################################################################
                    315: ###################################################################
                    316: 
                    317: package Apache::lonparmset;
                    318: 
                    319: use strict;
                    320: use Apache::lonnet;
                    321: use Apache::Constants qw(:common :http REDIRECT);
                    322: use Apache::lonhtmlcommon();
                    323: use Apache::loncommon;
                    324: use GDBM_File;
                    325: use Apache::lonhomework;
                    326: use Apache::lonxml;
                    327: use Apache::lonlocal;
                    328: use Apache::lonnavmaps;
                    329: use Apache::longroup;
                    330: use Apache::lonrss;
1.506     www       331: use HTML::Entities;
1.416     jms       332: use LONCAPA qw(:DEFAULT :match);
                    333: 
                    334: 
1.560     damieng   335: ##################################################
                    336: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
                    337: ##################################################
                    338: 
                    339: # Page header
1.561     damieng   340: #
                    341: # @param {Apache2::RequestRec} $r - Apache request object
                    342: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
                    343: # @param {string} $crstype - course type ('Community' for community settings)
1.507     www       344: sub startSettingsScreen {
1.531     raeburn   345:     my ($r,$mode,$crstype)=@_;
1.507     www       346: 
1.531     raeburn   347:     my $tabtext = &mt('Course Settings');
                    348:     if ($crstype eq 'Community') {
                    349:         $tabtext = &mt('Community Settings');
                    350:     } 
1.507     www       351:     $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
                    352:     $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b>&nbsp;&nbsp;&nbsp;&nbsp;'.
1.531     raeburn   353:                                           $tabtext.
1.507     www       354:                                           '&nbsp;&nbsp;&nbsp;&nbsp;</b></a></li>');
                    355: 
1.523     raeburn   356:     $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507     www       357:                                                                  &mt('Content and Problem Settings').'</b></a></li>');
                    358:     $r->print("\n".'</ul>'."\n");
1.523     raeburn   359:     $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507     www       360: }
                    361: 
1.560     damieng   362: # Page footer
1.507     www       363: sub endSettingsScreen {
                    364:    my ($r)=@_;
                    365:    $r->print('</div></div></div>');
                    366: }
                    367: 
                    368: 
                    369: 
1.560     damieng   370: ##################################################
1.563     damieng   371: # (mostly) TABLE MODE
1.560     damieng   372: # (parmval is also used for the log of parameter changes)
                    373: ##################################################
                    374: 
1.566     damieng   375: # Calls parmval_by_symb, getting the symb from $id with &symbcache.
1.561     damieng   376: #
                    377: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   378: # @param {string} $id - resource id or map pc
1.561     damieng   379: # @param {string} $def - the resource's default value for this parameter
                    380: # @param {string} $uname - user name
                    381: # @param {string} $udom - user domain
                    382: # @param {string} $csec - section name
                    383: # @param {string} $cgroup - group name
                    384: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    385: # @returns {Array}
1.2       www       386: sub parmval {
1.275     raeburn   387:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    388:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    389:                                                            $cgroup,$courseopt);
1.201     www       390: }
                    391: 
1.561     damieng   392: # Returns an array containing
                    393: # - the most specific level that is defined for that parameter (integer)
                    394: # - an array with the level as index and the parameter value as value (when defined)
                    395: #   (level 1 is the most specific and will have precedence)
                    396: #
                    397: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566     damieng   398: # @param {string} $symb - resource symb or map src
1.561     damieng   399: # @param {string} $def - the resource's default value for this parameter
                    400: # @param {string} $uname - user name
                    401: # @param {string} $udom - user domain
                    402: # @param {string} $csec - section name
                    403: # @param {string} $cgroup - group name
                    404: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                    405: # @returns {Array}
1.201     www       406: sub parmval_by_symb {
1.275     raeburn   407:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       408: 
1.352     albertel  409:     my $useropt;
                    410:     if ($uname ne '' && $udom ne '') {
1.561     damieng   411:         $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  412:     }
1.200     www       413: 
1.8       www       414:     my $result='';
1.44      albertel  415:     my @outpar=();
1.2       www       416: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    417:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  418:     $map = &Apache::lonnet::deversion($map);
1.561     damieng   419:     
                    420:     # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
                    421:     # any change should be reflected there.
                    422:     
1.201     www       423:     my $symbparm=$symb.'.'.$what;
1.556     raeburn   424:     my $recurseparm=$map.'___(rec).'.$what; 
1.201     www       425:     my $mapparm=$map.'___(all).'.$what;
1.10      www       426: 
1.269     raeburn   427:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    428:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   429:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   430:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    431: 
1.190     albertel  432:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    433:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   434:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  435:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    436: 
                    437:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    438:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   439:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  440:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       441: 
1.11      www       442: 
1.182     albertel  443: # --------------------------------------------------------- first, check course
1.11      www       444: 
1.561     damieng   445: # 18 - General Course
1.200     www       446:     if (defined($$courseopt{$courselevel})) {
1.556     raeburn   447:         $outpar[18]=$$courseopt{$courselevel};
                    448:         $result=18;
                    449:     }
                    450: 
1.561     damieng   451: # 17 - Map or Folder level in course (recursive) 
1.556     raeburn   452:     if (defined($$courseopt{$courseleveli})) {
                    453:         $outpar[17]=$$courseopt{$courseleveli};
                    454:         $result=17;
1.43      albertel  455:     }
1.11      www       456: 
1.561     damieng   457: # 16 - Map or Folder level in course (non-recursive)
1.200     www       458:     if (defined($$courseopt{$courselevelm})) {
1.556     raeburn   459:         $outpar[16]=$$courseopt{$courselevelm};
                    460:         $result=16;
1.43      albertel  461:     }
1.11      www       462: 
1.182     albertel  463: # ------------------------------------------------------- second, check default
                    464: 
1.561     damieng   465: # 15 - resource default
1.556     raeburn   466:     if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182     albertel  467: 
                    468: # ------------------------------------------------------ third, check map parms
                    469: 
1.556     raeburn   470:     
1.561     damieng   471: # 14 - map default
1.376     albertel  472:     my $thisparm=&parmhash($symbparm);
1.556     raeburn   473:     if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182     albertel  474: 
1.561     damieng   475: # 13 - resource level in course
1.200     www       476:     if (defined($$courseopt{$courselevelr})) {
1.556     raeburn   477:         $outpar[13]=$$courseopt{$courselevelr};
                    478:         $result=13;
1.43      albertel  479:     }
1.11      www       480: 
1.182     albertel  481: # ------------------------------------------------------ fourth, back to course
1.352     albertel  482:     if ($csec ne '') {
1.561     damieng   483: # 12 - General for section
1.200     www       484:         if (defined($$courseopt{$seclevel})) {
1.556     raeburn   485:             $outpar[12]=$$courseopt{$seclevel};
                    486:             $result=12;
                    487:         }
1.561     damieng   488: # 11 - Map or Folder level for section (recursive)
1.556     raeburn   489:         if (defined($$courseopt{$secleveli})) {
                    490:             $outpar[11]=$$courseopt{$secleveli};
                    491:             $result=11;
                    492:         }
1.561     damieng   493: # 10 - Map or Folder level for section (non-recursive)
1.200     www       494:         if (defined($$courseopt{$seclevelm})) {
1.556     raeburn   495:             $outpar[10]=$$courseopt{$seclevelm};
                    496:             $result=10;
                    497:         }
1.561     damieng   498: # 9 - resource level in section
1.200     www       499:         if (defined($$courseopt{$seclevelr})) {
1.556     raeburn   500:             $outpar[9]=$$courseopt{$seclevelr};
                    501:             $result=9;
                    502:         }
1.43      albertel  503:     }
1.275     raeburn   504: # ------------------------------------------------------ fifth, check course group
1.352     albertel  505:     if ($cgroup ne '') {
1.561     damieng   506: # 8 - General for group
1.269     raeburn   507:         if (defined($$courseopt{$grplevel})) {
1.556     raeburn   508:             $outpar[8]=$$courseopt{$grplevel};
                    509:             $result=8;
                    510:         }
1.561     damieng   511: # 7 - Map or Folder level for group (recursive)
1.556     raeburn   512:         if (defined($$courseopt{$grpleveli})) {
                    513:             $outpar[7]=$$courseopt{$grpleveli};
                    514:             $result=7;
1.269     raeburn   515:         }
1.561     damieng   516: # 6 - Map or Folder level for group (non-recursive)
1.269     raeburn   517:         if (defined($$courseopt{$grplevelm})) {
1.556     raeburn   518:             $outpar[6]=$$courseopt{$grplevelm};
                    519:             $result=6;
1.269     raeburn   520:         }
1.561     damieng   521: # 5 - resource level in group
1.269     raeburn   522:         if (defined($$courseopt{$grplevelr})) {
1.556     raeburn   523:             $outpar[5]=$$courseopt{$grplevelr};
                    524:             $result=5;
1.269     raeburn   525:         }
                    526:     }
1.11      www       527: 
1.556     raeburn   528: # ---------------------------------------------------------- sixth, check user
1.11      www       529: 
1.352     albertel  530:     if ($uname ne '') {
1.561     damieng   531: # 4 - General for specific student
                    532:         if (defined($$useropt{$courselevel})) {
                    533:             $outpar[4]=$$useropt{$courselevel};
                    534:             $result=4;
                    535:         }
1.556     raeburn   536: 
1.561     damieng   537: # 3 - Map or Folder level for specific student (recursive)
                    538:         if (defined($$useropt{$courseleveli})) {
                    539:             $outpar[3]=$$useropt{$courseleveli};
                    540:             $result=3;
                    541:         }
1.473     amueller  542: 
1.561     damieng   543: # 2 - Map or Folder level for specific student (non-recursive)
                    544:         if (defined($$useropt{$courselevelm})) {
                    545:             $outpar[2]=$$useropt{$courselevelm};
                    546:             $result=2;
                    547:         }
1.473     amueller  548: 
1.561     damieng   549: # 1 - resource level for specific student
                    550:         if (defined($$useropt{$courselevelr})) {
                    551:             $outpar[1]=$$useropt{$courselevelr};
                    552:             $result=1;
                    553:         }
1.43      albertel  554:     }
1.44      albertel  555:     return ($result,@outpar);
1.2       www       556: }
                    557: 
1.198     www       558: 
                    559: 
1.376     albertel  560: # --- Caches local to lonparmset
                    561: 
1.446     bisitz    562: 
1.561     damieng   563: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376     albertel  564: sub reset_caches {
                    565:     &resetparmhash();
                    566:     &resetsymbcache();
                    567:     &resetrulescache();
1.203     www       568: }
                    569: 
1.561     damieng   570: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
                    571: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376     albertel  572: {
1.561     damieng   573:     my $parmhashid; # course identifier, to initialize the cache only once for a course
                    574:     my %parmhash; # the parameter cache
                    575:     # reset map parameter hash
1.376     albertel  576:     sub resetparmhash {
1.560     damieng   577:         undef($parmhashid);
                    578:         undef(%parmhash);
1.376     albertel  579:     }
1.446     bisitz    580: 
1.561     damieng   581:     # dump the _parms.db database into %parmhash
1.376     albertel  582:     sub cacheparmhash {
1.560     damieng   583:         if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    584:         my %parmhashfile;
                    585:         if (tie(%parmhashfile,'GDBM_File',
                    586:             $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    587:             %parmhash=%parmhashfile;
                    588:             untie(%parmhashfile);
                    589:             $parmhashid=$env{'request.course.fn'};
                    590:         }
1.201     www       591:     }
1.446     bisitz    592: 
1.561     damieng   593:     # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376     albertel  594:     sub parmhash {
1.560     damieng   595:         my ($id) = @_;
                    596:         &cacheparmhash();
                    597:         return $parmhash{$id};
1.376     albertel  598:     }
1.560     damieng   599: }
1.376     albertel  600: 
1.566     damieng   601: # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
1.446     bisitz    602: {
1.561     damieng   603:     my $symbsid; # course identifier, to initialize the cache only once for a course
                    604:     my %symbs; # hash id->symb
                    605:     # reset the id->symb cache
1.376     albertel  606:     sub resetsymbcache {
1.560     damieng   607:         undef($symbsid);
                    608:         undef(%symbs);
1.376     albertel  609:     }
1.446     bisitz    610: 
1.566     damieng   611:     # returns the resource symb or map src corresponding to a resource id or map pc
                    612:     # (using lonnavmaps and a cache)
1.376     albertel  613:     sub symbcache {
1.560     damieng   614:         my $id=shift;
                    615:         if ($symbsid ne $env{'request.course.id'}) {
                    616:             undef(%symbs);
                    617:         }
                    618:         if (!$symbs{$id}) {
                    619:             my $navmap = Apache::lonnavmaps::navmap->new();
                    620:             if ($id=~/\./) {
                    621:                 my $resource=$navmap->getById($id);
                    622:                 $symbs{$id}=$resource->symb();
                    623:             } else {
                    624:                 my $resource=$navmap->getByMapPc($id);
                    625:                 $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    626:             }
                    627:             $symbsid=$env{'request.course.id'};
1.473     amueller  628:         }
1.560     damieng   629:         return $symbs{$id};
1.473     amueller  630:     }
1.560     damieng   631: }
1.201     www       632: 
1.561     damieng   633: # cache for parameter default actions (stored in parmdefactions.db)
1.446     bisitz    634: {
1.561     damieng   635:     my $rulesid; # course identifier, to initialize the cache only once for a course
                    636:     my %rules; # parameter default actions hash
1.376     albertel  637:     sub resetrulescache {
1.560     damieng   638:         undef($rulesid);
                    639:         undef(%rules);
1.376     albertel  640:     }
1.446     bisitz    641: 
1.561     damieng   642:     # returns the value for a given key in the parameter default action hash
1.376     albertel  643:     sub rulescache {
1.560     damieng   644:         my $id=shift;
                    645:         if ($rulesid ne $env{'request.course.id'}
                    646:             && !defined($rules{$id})) {
                    647:             my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    648:             my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    649:             %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    650:             $rulesid=$env{'request.course.id'};
                    651:         }
                    652:         return $rules{$id};
1.221     www       653:     }
                    654: }
                    655: 
1.416     jms       656: 
1.561     damieng   657: # Returns the values of the parameter type default action
                    658: # "default value when manually setting".
                    659: # If none is defined, ('','','','','') is returned.
                    660: #
                    661: # @param {string} $type - parameter type
                    662: # @returns {Array<string>} - (hours, min, sec, value)
1.229     www       663: sub preset_defaults {
                    664:     my $type=shift;
                    665:     if (&rulescache($type.'_action') eq 'default') {
1.560     damieng   666:         # yes, there is something
                    667:         return (&rulescache($type.'_hours'),
                    668:             &rulescache($type.'_min'),
                    669:             &rulescache($type.'_sec'),
                    670:             &rulescache($type.'_value'));
1.229     www       671:     } else {
1.560     damieng   672:         # nothing there or something else
                    673:         return ('','','','','');
1.229     www       674:     }
                    675: }
                    676: 
1.416     jms       677: 
1.561     damieng   678: # Checks that a date is after enrollment start date and before
                    679: # enrollment end date.
                    680: # Returns HTML with a warning if it is not, or the empty string otherwise.
                    681: # This is used by both overview and table modes.
                    682: #
                    683: # @param {integer} $checkdate - the date to check.
                    684: # @returns {string} - HTML possibly containing a localized warning message.
1.277     www       685: sub date_sanity_info {
                    686:    my $checkdate=shift;
                    687:    unless ($checkdate) { return ''; }
                    688:    my $result='';
                    689:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    690:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    691:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    692:          $result.='<div class="LC_warning">'
                    693:                  .&mt('After course enrollment end!')
                    694:                  .'</div>';
1.277     www       695:       }
                    696:    }
                    697:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    698:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    699:          $result.='<div class="LC_warning">'
                    700:                  .&mt('Before course enrollment start!')
                    701:                  .'</div>';
1.277     www       702:       }
                    703:    }
1.413     bisitz    704: # Preparation for additional warnings about dates in the past/future.
                    705: # An improved, more context sensitive version is recommended,
                    706: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    707: #   if ($checkdate<time) {
                    708: #      $result.='<div class="LC_info">'
                    709: #              .'('.&mt('in the past').')'
                    710: #              .'</div>';
                    711: #      }
                    712: #   if ($checkdate>time) {
                    713: #      $result.='<div class="LC_info">'
                    714: #              .'('.&mt('in the future').')'
                    715: #              .'</div>';
                    716: #      }
1.277     www       717:    return $result;
                    718: }
1.561     damieng   719: 
                    720: 
                    721: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186     www       722: #
1.566     damieng   723: # @param {string} $sresid - resource id or map pc
1.565     damieng   724: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   725: # @param {integer} $snum - level
                    726: # @param {string} $nval - new value
                    727: # @param {string} $ntype - new type
                    728: # @param {string} $uname - username
                    729: # @param {string} $udom - userdomain
                    730: # @param {string} $csec - section name
                    731: # @param {string} $cgroup - group name
1.186     www       732: sub storeparm {
1.269     raeburn   733:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   734:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       735: }
                    736: 
1.561     damieng   737: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
                    738: 
                    739: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
                    740: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
                    741: #
1.566     damieng   742: # @param {string} $symb - resource symb or map src
1.565     damieng   743: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561     damieng   744: # @param {integer} $snum - level
                    745: # @param {string} $nval - new value
                    746: # @param {string} $ntype - new type
                    747: # @param {string} $uname - username
                    748: # @param {string} $udom - userdomain
                    749: # @param {string} $csec - section name
                    750: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
                    751: # @param {string} $cgroup - group name
1.197     www       752: sub storeparm_by_symb {
1.275     raeburn   753:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       754:     unless ($recflag) {
1.560     damieng   755:         # first time call
                    756:         %recstack=();
                    757:         $recflag=1;
1.226     www       758:     }
1.560     damieng   759:     # store parameter
1.226     www       760:     &storeparm_by_symb_inner
1.473     amueller  761:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560     damieng   762:     # don't do anything if parameter was reset
1.266     www       763:     unless ($nval) { return; }
1.226     www       764:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560     damieng   765:     # remember that this was set
1.226     www       766:     $recstack{$parm}=1;
1.560     damieng   767:     # what does this trigger?
1.226     www       768:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560     damieng   769:         # don't backfire
                    770:         unless ((!$triggered) || ($recstack{$triggered})) {
                    771:             my $action=&rulescache($triggered.'_action');
                    772:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    773:             # set triggered parameter on same level
                    774:             my $newspnam=$prefix.$triggered;
                    775:             my $newvalue='';
                    776:             my $active=1;
                    777:             if ($action=~/^when\_setting/) {
                    778:             # are there restrictions?
                    779:                 if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    780:                     $active=0;
1.565     damieng   781:                     foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560     damieng   782:                         if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    783:                     }
                    784:                 }
                    785:                 $newvalue=&rulescache($triggered.'_value');
                    786:             } else {
                    787:                 my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    788:                 if ($action=~/^later\_than/) {
                    789:                     $newvalue=$nval+$totalsecs;
                    790:                 } else {
                    791:                     $newvalue=$nval-$totalsecs;
                    792:                 }
                    793:             }
                    794:             if ($active) {
                    795:                 &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    796:                         $uname,$udom,$csec,$recflag,$cgroup);
                    797:             }
                    798:         }
1.226     www       799:     }
                    800:     return '';
                    801: }
                    802: 
1.561     damieng   803: # Adds all given arguments to the course parameter log.
                    804: # @returns {string} - the answer to the lonnet query.
1.293     www       805: sub log_parmset {
1.525     raeburn   806:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       807: }
                    808: 
1.561     damieng   809: # Store a parameter value and type by symb, without using the parameter default actions.
                    810: # Expire related sheets.
                    811: #
1.566     damieng   812: # @param {string} $symb - resource symb or map src
1.561     damieng   813: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
                    814: # @param {integer} $snum - level
                    815: # @param {string} $nval - new value
                    816: # @param {string} $ntype - new type
                    817: # @param {string} $uname - username
                    818: # @param {string} $udom - userdomain
                    819: # @param {string} $csec - section name
                    820: # @param {string} $cgroup - group name
                    821: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226     www       822: sub storeparm_by_symb_inner {
1.197     www       823: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   824:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       825: # ---------------------------------------------------------- Construct prefixes
1.186     www       826:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    827:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  828:     $map = &Apache::lonnet::deversion($map);
                    829: 
1.197     www       830:     my $symbparm=$symb.'.'.$spnam;
1.556     raeburn   831:     my $recurseparm=$map.'___(rec).'.$spnam;
1.197     www       832:     my $mapparm=$map.'___(all).'.$spnam;
                    833: 
1.269     raeburn   834:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    835:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556     raeburn   836:     my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269     raeburn   837:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    838: 
1.190     albertel  839:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    840:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556     raeburn   841:     my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190     albertel  842:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    843: 
1.190     albertel  844:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    845:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556     raeburn   846:     my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190     albertel  847:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    848: 
1.186     www       849:     my $storeunder='';
1.578     raeburn   850:     my $possreplace='';
1.556     raeburn   851:     if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
1.578     raeburn   852:     if (($snum==17) || ($snum==3)) { 
                    853:         $storeunder=$courseleveli;
                    854:         $possreplace=$courselevelm; 
                    855:     } 
                    856:     if (($snum==16) || ($snum==2)) { 
                    857:         $storeunder=$courselevelm;
                    858:         $possreplace=$courseleveli;
                    859:     }
1.556     raeburn   860:     if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
                    861:     if ($snum==12) { $storeunder=$seclevel; }
1.578     raeburn   862:     if ($snum==11) { 
                    863:         $storeunder=$secleveli;
                    864:         $possreplace=$seclevelm; 
                    865:     }
                    866:     if ($snum==10) { 
                    867:         $storeunder=$seclevelm;
                    868:         $possreplace=$secleveli;
                    869:     }
1.556     raeburn   870:     if ($snum==9) { $storeunder=$seclevelr; }
                    871:     if ($snum==8) { $storeunder=$grplevel; }
1.578     raeburn   872:     if ($snum==7) { 
                    873:         $storeunder=$grpleveli;
                    874:         $possreplace=$grplevelm;
                    875:     }
                    876:     if ($snum==6) {
                    877:         $storeunder=$grplevelm;
                    878:         $possreplace=$grpleveli;
                    879:     }
1.556     raeburn   880:     if ($snum==5) { $storeunder=$grplevelr; }
1.269     raeburn   881: 
1.446     bisitz    882: 
1.186     www       883:     my $delete;
                    884:     if ($nval eq '') { $delete=1;}
                    885:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  886:             $storeunder.'.type' => $ntype);
1.186     www       887:     my $reply='';
1.560     damieng   888:     
1.556     raeburn   889:     if ($snum>4) {
1.186     www       890: # ---------------------------------------------------------------- Store Course
                    891: #
1.560     damieng   892:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    893:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    894:         # Expire sheets
                    895:         &Apache::lonnet::expirespread('','','studentcalc');
                    896:         if (($snum==13) || ($snum==9) || ($snum==5)) {
                    897:             &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.578     raeburn   898:         } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
1.560     damieng   899:             &Apache::lonnet::expirespread('','','assesscalc',$map);
                    900:         } else {
                    901:             &Apache::lonnet::expirespread('','','assesscalc');
                    902:         }
                    903:         # Store parameter
                    904:         if ($delete) {
                    905:             $reply=&Apache::lonnet::del
                    906:             ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
                    907:                 &log_parmset(\%storecontent,1);
                    908:         } else {
                    909:             $reply=&Apache::lonnet::cput
                    910:             ('resourcedata',\%storecontent,$cdom,$cnum);
                    911:             &log_parmset(\%storecontent);
1.578     raeburn   912:             if ($possreplace) {
                    913:                 my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
                    914:                 if (ref($resdata) eq 'HASH') {
                    915:                     if (exists($resdata->{$possreplace})) {
                    916:                         if (&Apache::lonnet::del
                    917:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
                    918:                             &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);   
                    919:                         }
                    920:                     }
                    921:                 }
                    922:             }
1.560     damieng   923:         }
                    924:         &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       925:     } else {
                    926: # ------------------------------------------------------------------ Store User
                    927: #
1.560     damieng   928:         # Expire sheets
                    929:         &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    930:         if ($snum==1) {
                    931:             &Apache::lonnet::expirespread
                    932:             ($uname,$udom,'assesscalc',$symb);
1.578     raeburn   933:         } elsif (($snum==2) || ($snum==3)) {
1.560     damieng   934:             &Apache::lonnet::expirespread
                    935:             ($uname,$udom,'assesscalc',$map);
                    936:         } else {
                    937:             &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    938:         }
                    939:         # Store parameter
                    940:         if ($delete) {
                    941:             $reply=&Apache::lonnet::del
                    942:             ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    943:             &log_parmset(\%storecontent,1,$uname,$udom);
                    944:         } else {
                    945:             $reply=&Apache::lonnet::cput
                    946:             ('resourcedata',\%storecontent,$udom,$uname);
                    947:             &log_parmset(\%storecontent,0,$uname,$udom);
1.578     raeburn   948:             if ($possreplace) {
                    949:                 my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
                    950:                 if (ref($resdata) eq 'HASH') {
                    951:                     if (exists($resdata->{$possreplace})) {
                    952:                         if (&Apache::lonnet::del
                    953:                             ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
                    954:                             &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
                    955:                                           $uname,$udom);
                    956:                         }
                    957:                     }
                    958:                 }
                    959:             }
1.560     damieng   960:         }
                    961:         &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       962:     }
1.446     bisitz    963: 
1.186     www       964:     if ($reply=~/^error\:(.*)/) {
1.560     damieng   965:         return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       966:     }
                    967:     return '';
                    968: }
                    969: 
1.9       www       970: 
1.561     damieng   971: # Returns HTML with the value of the given parameter,
                    972: # using a readable format for dates, and
                    973: # a warning if there is a problem with a date.
                    974: # Used by table mode.
                    975: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
                    976: #
                    977: # @param {string} $value - the parameter value
                    978: # @param {string} $type - the parameter type
                    979: # @param {string} $name - the parameter name (unused)
                    980: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9       www       981: sub valout {
1.554     raeburn   982:     my ($value,$type,$name,$editable)=@_;
1.59      matthew   983:     my $result = '';
                    984:     # Values of zero are valid.
                    985:     if (! $value && $value ne '0') {
1.528     bisitz    986:         if ($editable) {
                    987:             $result =
                    988:                 '<img src="/res/adm/pages/editmap.png"'
                    989:                .' alt="'.&mt('Change').'"'
1.539     raeburn   990:                .' title="'.&mt('Change').'" style="border:0;" />';
1.528     bisitz    991:         } else {
                    992:             $result='&nbsp;';
                    993:         }
1.59      matthew   994:     } else {
1.66      www       995:         if ($type eq 'date_interval') {
1.559     raeburn   996:             my ($totalsecs,$donesuffix) = split(/_/,$value,2);
                    997:             my ($usesdone,$donebuttontext,$proctor,$secretkey);
                    998:             if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
                    999:                 $donebuttontext = $1;
                   1000:                 (undef,$proctor,$secretkey) = split(/_/,$2);
                   1001:                 $usesdone = 'done';
                   1002:             } elsif ($donesuffix =~ /^done(|_.+)$/) {
                   1003:                 $donebuttontext = &mt('Done');
                   1004:                 ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
                   1005:             }
1.554     raeburn  1006:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413     bisitz   1007:             my @timer;
1.66      www      1008:             $year=$year-70;
                   1009:             $mday--;
                   1010:             if ($year) {
1.413     bisitz   1011: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                   1012:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www      1013:             }
                   1014:             if ($mon) {
1.413     bisitz   1015: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                   1016:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www      1017:             }
                   1018:             if ($mday) {
1.413     bisitz   1019: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                   1020:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www      1021:             }
                   1022:             if ($hour) {
1.413     bisitz   1023: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                   1024:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www      1025:             }
                   1026:             if ($min) {
1.413     bisitz   1027: #               $result.=&mt('[quant,_1,min]',$min).' ';
                   1028:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www      1029:             }
                   1030:             if ($sec) {
1.413     bisitz   1031: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                   1032:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www      1033:             }
1.413     bisitz   1034: #           $result=~s/\s+$//;
                   1035:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                   1036:                 push(@timer,&mt('[quant,_1,sec]',0));
                   1037:             }
                   1038:             $result.=join(", ",@timer);
1.559     raeburn  1039:             if ($usesdone eq 'done') {
1.558     raeburn  1040:                 if ($secretkey) {
1.559     raeburn  1041:                     $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);  
1.558     raeburn  1042:                 } else {
1.559     raeburn  1043:                     $result .= ' + "'.$donebuttontext.'"';
                   1044:                 }
1.554     raeburn  1045:             }
1.213     www      1046:         } elsif (&isdateparm($type)) {
1.361     albertel 1047:             $result = &Apache::lonlocal::locallocaltime($value).
1.560     damieng  1048:                 &date_sanity_info($value);
1.59      matthew  1049:         } else {
                   1050:             $result = $value;
1.517     www      1051:             $result=~s/\,/\, /gs;
1.560     damieng  1052:             $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew  1053:         }
                   1054:     }
                   1055:     return $result;
1.9       www      1056: }
                   1057: 
1.59      matthew  1058: 
1.561     damieng  1059: # Returns HTML containing a link on a parameter value, for table mode.
                   1060: # The link uses the javascript function 'pjump'.
                   1061: #
                   1062: # @param {string} $type - parameter type
                   1063: # @param {string} $dis - dialog title for editing the parameter value and type
                   1064: # @param {string} $value - parameter value
                   1065: # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
                   1066: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
                   1067: # @param {string} $call - javascript function to call to submit the form ('psub')
1.588     raeburn  1068: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
                   1069: # @param {string} $extra - optional additional information to send as tenth arg in call to javascript pjump function.
1.5       www      1070: sub plink {
1.588     raeburn  1071:     my ($type,$dis,$value,$marker,$return,$call,$recursive,$extra)=@_;
1.23      www      1072:     my $winvalue=$value;
                   1073:     unless ($winvalue) {
1.589   ! raeburn  1074:         if ((&isdateparm($type) || (&is_specialstring($type))) {
1.190     albertel 1075:             $winvalue=$env{'form.recent_'.$type};
1.23      www      1076:         } else {
1.190     albertel 1077:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1078:         }
                   1079:     }
1.229     www      1080:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1081:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1082:     unless (defined($winvalue)) { $winvalue=$val; }
1.554     raeburn  1083:     my $valout = &valout($value,$type,$parmname,1);
1.429     raeburn  1084:     my $unencmarker = $marker;
1.378     albertel 1085:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.588     raeburn  1086:               \$hour, \$min, \$sec, \$extra) {
1.560     damieng  1087:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1088:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1089:     }
1.429     raeburn  1090:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1091:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.588     raeburn  1092:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."','".$extra."'".');">'.
1.578     raeburn  1093:         $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
                   1094:                                               &mt('recursive').'</td></tr>' : '').'</table>';
                   1095: 
1.5       www      1096: }
                   1097: 
1.561     damieng  1098: # Javascript for table mode.
1.280     albertel 1099: sub page_js {
                   1100: 
1.81      www      1101:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1102:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1103: 
                   1104:     return(<<ENDJS);
                   1105: <script type="text/javascript">
1.454     bisitz   1106: // <![CDATA[
1.44      albertel 1107: 
1.88      matthew  1108:     $pjump_def
1.44      albertel 1109: 
                   1110:     function psub() {
1.589   ! raeburn  1111:         var specstring = /^string_/i;
1.44      albertel 1112:         if (document.parmform.pres_marker.value!='') {
                   1113:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1114:             var typedef=new Array();
                   1115:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1116:             if (document.parmform.pres_type.value!='') {
1.589   ! raeburn  1117:                 if ((typedef[0]=='date') || 
        !          1118:                     (specstring.test(document.parmform.pres_type.value) && (typedef[1]!='yesno')))  {
1.562     damieng  1119:                     eval('document.parmform.recent_'+
                   1120:                         document.parmform.pres_type.value+
                   1121:                         '.value=document.parmform.pres_value.value;');
                   1122:                 } else {
                   1123:                     eval('document.parmform.recent_'+typedef[0]+
                   1124:                         '.value=document.parmform.pres_value.value;');
                   1125:                 }
1.44      albertel 1126:             }
                   1127:             document.parmform.submit();
                   1128:         } else {
                   1129:             document.parmform.pres_value.value='';
                   1130:             document.parmform.pres_marker.value='';
                   1131:         }
                   1132:     }
                   1133: 
1.57      albertel 1134:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1135:         var options = "width=" + w + ",height=" + h + ",";
                   1136:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1137:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1138:         var newWin = window.open(url, wdwName, options);
                   1139:         newWin.focus();
                   1140:     }
1.523     raeburn  1141: 
1.454     bisitz   1142: // ]]>
1.523     raeburn  1143: 
1.44      albertel 1144: </script>
1.81      www      1145: $selscript
1.280     albertel 1146: ENDJS
                   1147: 
                   1148: }
1.507     www      1149: 
1.561     damieng  1150: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1151: # for table and overview modes.
1.523     raeburn  1152: sub showhide_js {
                   1153:     return <<"COURSECONTENTSCRIPT";
                   1154: 
                   1155: function showHide_courseContent() {
                   1156:     var parmlevValue=document.getElementById("parmlev").value;
                   1157:     if (parmlevValue == 'general') {
                   1158:         document.getElementById('mapmenu').style.display="none";
                   1159:     } else {
                   1160:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1161:             document.getElementById('mapmenu').style.display ="";
                   1162:         } else {
                   1163:             document.getElementById('mapmenu').style.display="none";
                   1164:         }
                   1165:     }
                   1166:     return;
                   1167: }
                   1168: 
                   1169: COURSECONTENTSCRIPT
                   1170: }
                   1171: 
1.561     damieng  1172: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1173: sub toggleparmtextbox_js {
                   1174:     return <<"ENDSCRIPT";
                   1175: 
                   1176: if (!document.getElementsByClassName) {
                   1177:     function getElementsByClassName(node, classname) {
                   1178:         var a = [];
                   1179:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1180:         var els = node.getElementsByTagName("*");
                   1181:         for(var i=0,j=els.length; i<j; i++)
                   1182:             if(re.test(els[i].className))a.push(els[i]);
                   1183:         return a;
                   1184:     }
                   1185: }
                   1186: 
                   1187: function showHideLenient() {
                   1188:     var lenients;
                   1189:     var setRegExp = /^set_/;
                   1190:     if (document.getElementsByClassName) {
                   1191:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1192:     } else {
                   1193:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1194:     }
                   1195:     if (lenients != 'undefined') {
                   1196:         for (var i=0; i<lenients.length; i++) {
                   1197:             if (lenients[i].checked) {
                   1198:                 if (lenients[i].value == 'weighted') {
                   1199:                     if (setRegExp.test(lenients[i].name)) {
                   1200:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1201:                         toggleParmTextbox(document.parmform,identifier);
                   1202:                     }
                   1203:                 }
                   1204:             }
                   1205:         }
                   1206:     }
                   1207:     return;
                   1208: }
                   1209: 
                   1210: function toggleParmTextbox(form,key) {
                   1211:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1212:     if (divfortext) {
                   1213:         var caller = form.elements['set_'+key];
                   1214:         if (caller.length) {
                   1215:             for (i=0; i<caller.length; i++) {
                   1216:                 if (caller[i].checked) {
                   1217:                     if (caller[i].value == 'weighted') {
                   1218:                         divfortext.style.display = 'inline';
                   1219:                     } else {
                   1220:                         divfortext.style.display = 'none';
                   1221:                     }
                   1222:                 }
                   1223:             }
                   1224:         }
                   1225:     }
                   1226:     return;
                   1227: }
                   1228: 
                   1229: ENDSCRIPT
                   1230: }
                   1231: 
1.561     damieng  1232: # Javascript function validateParms, for overview mode
1.549     raeburn  1233: sub validateparms_js {
                   1234:     return <<'ENDSCRIPT';
                   1235: 
                   1236: function validateParms() {
                   1237:     var textRegExp = /^settext_/;
                   1238:     var tailLenient = /\.lenient$/;
                   1239:     var patternRelWeight = /^\-?[\d.]+$/;
                   1240:     var patternLenientStd = /^(yes|no|default)$/;
                   1241:     var ipallowRegExp = /^setipallow_/;
                   1242:     var ipdenyRegExp = /^setipdeny_/; 
1.588     raeburn  1243:     var deeplinkRegExp = /^deeplink_(listing|scope)_/;
                   1244:     var deeplinkUrlsRegExp = /^deeplink_urls_/;
                   1245:     var deeplinkltiRegExp = /^deeplink_lti_/;
                   1246:     var deeplinkkeyRegExp = /^deeplink_key_/;
1.549     raeburn  1247:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1248:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1249:         if (document.parmform.elements.length) {
                   1250:             for (i=0; i<document.parmform.elements.length; i++) {
                   1251:                 var name=document.parmform.elements[i].name;
1.588     raeburn  1252:                 if (textRegExp.test(name)) {
1.549     raeburn  1253:                     var identifier = name.replace(textRegExp,'');
                   1254:                     if (tailLenient.test(identifier)) {
                   1255:                         if (document.parmform.elements['set_'+identifier].length) {
                   1256:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1257:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1258:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1259:                                         var relweight = document.parmform.elements[i].value;
                   1260:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1261:                                         if (!patternRelWeight.test(relweight)) {
                   1262:                                             relweight = '0.0';
                   1263:                                         }
                   1264:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1265:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1266:                                         } else {
                   1267:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1268:                                         }
                   1269:                                     }
                   1270:                                     break;
                   1271:                                 }
                   1272:                             }
                   1273:                         }
                   1274:                     }
1.588     raeburn  1275:                 } else if (ipallowRegExp.test(name)) {
                   1276:                     var identifier = name.replace(ipallowRegExp,'');
                   1277:                     var possallow = document.parmform.elements[i].value;
                   1278:                     possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1279:                     if (patternIP.test(possallow)) {
                   1280:                         if (document.parmform.elements['set_'+identifier].value) {
                   1281:                             possallow = ','+possallow;
                   1282:                         }
                   1283:                         document.parmform.elements['set_'+identifier].value += possallow;
                   1284:                     }
                   1285:                 } else if (ipdenyRegExp.test(name)) {
                   1286:                     var identifier = name.replace(ipdenyRegExp,'');
                   1287:                     var possdeny = document.parmform.elements[i].value;
                   1288:                     possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1289:                     if (patternIP.test(possdeny)) {
                   1290:                         possdeny = '!'+possdeny;
                   1291:                         if (document.parmform.elements['set_'+identifier].value) {
                   1292:                             possdeny = ','+possdeny;
                   1293:                         }
                   1294:                         document.parmform.elements['set_'+identifier].value += possdeny;
                   1295:                     }
                   1296:                 } else if (deeplinkRegExp.test(name)) {
                   1297:                     var identifier =  name.replace(deeplinkRegExp,'');
                   1298:                     var possdeeplink = document.parmform.elements[i].value;
                   1299:                     possdeeplink = possdeeplink.replace(/^\s+|\s+$/g,'');
                   1300:                     if (document.parmform.elements['set_'+identifier].value) {
                   1301:                         possdeeplink = ','+possdeeplink;
                   1302:                     }
                   1303:                     document.parmform.elements['set_'+identifier].value += possdeeplink;
                   1304:                 } else if (deeplinkUrlsRegExp.test(name)) {
                   1305:                     if (document.parmform.elements[i].checked) {
                   1306:                         var identifier =  name.replace(deeplinkUrlsRegExp,'');
                   1307:                         var posslinkurl = document.parmform.elements[i].value;
                   1308:                         posslinkurl = posslinkurl.replace(/^\s+|\s+$/g,'');
                   1309:                         if (document.parmform.elements['set_'+identifier].value) {
                   1310:                             posslinkurl = ','+posslinkurl;
                   1311:                         }
                   1312:                         document.parmform.elements['set_'+identifier].value += posslinkurl;
                   1313:                     }
                   1314:                 } else if (deeplinkltiRegExp.test(name)) {
                   1315:                     var identifier = name.replace(deeplinkltiRegExp,'');
                   1316:                     var posslti = document.parmform.elements[i].value;
                   1317:                     posslti = posslti.replace(/\D+/g,'');
                   1318:                     if (document.parmform.elements['set_'+identifier].value) {
                   1319:                         posslti = ':'+posslti;
                   1320:                     }
                   1321:                     document.parmform.elements['set_'+identifier].value += posslti;
                   1322:                 } else if (deeplinkkeyRegExp.test(name)) {
                   1323:                     var identifier = name.replace(deeplinkkeyRegExp,'');
                   1324:                     var posskey = document.parmform.elements[i].value;
                   1325:                     posskey = posskey.replace(/\W+/g,'');
                   1326:                     if (document.parmform.elements['set_'+identifier].value) {
                   1327:                         posslti = ':'+posskey;
1.549     raeburn  1328:                     }
1.588     raeburn  1329:                     document.parmform.elements['set_'+identifier].value += posskey;
1.549     raeburn  1330:                 }
                   1331:             }
                   1332:         }
                   1333:     }
                   1334:     return true;
                   1335: }
                   1336: 
                   1337: ENDSCRIPT
                   1338: }
                   1339: 
1.561     damieng  1340: # Javascript initialization, for overview mode
1.549     raeburn  1341: sub ipacc_boxes_js  {
                   1342:     my $remove = &mt('Remove');
                   1343:     return <<"END";
                   1344: \$(document).ready(function() {
                   1345:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1346:     var add_button      = \$(".LC_add_ipacc_button");
                   1347:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1348: 
                   1349:     \$(add_button).click(function(e){
                   1350:         e.preventDefault();
                   1351:         var identifier = \$(this).closest("div").attr("id");
                   1352:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1353:         \$(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  1354:     });
                   1355: 
                   1356:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1357:         e.preventDefault(); \$(this).closest("div").remove();
                   1358:     })
                   1359: });
                   1360: 
                   1361: 
                   1362: END
                   1363: }
                   1364: 
1.561     damieng  1365: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1366: sub done_proctor_js {
                   1367:     return <<"END";
                   1368: function toggleSecret(form,radio,key) {
                   1369:     var radios = form[radio+key];
                   1370:     if (radios.length) {
                   1371:         for (var i=0; i<radios.length; i++) {
                   1372:             if (radios[i].checked) {
                   1373:                 if (radios[i].value == '_done_proctor') {
                   1374:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1375:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1376:                     }
                   1377:                 } else {
                   1378:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1379:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1380:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1381:                     }
                   1382:                 }
                   1383:             }
                   1384:         }
                   1385:     }
                   1386: }
                   1387: END
                   1388: 
                   1389: }
                   1390: 
1.588     raeburn  1391: # Javascript function toggle
                   1392: sub deeplink_js {
                   1393:     return <<"END";
                   1394: function toggleDeepLink(form,item,key) {
                   1395:     var radios = form['deeplink_'+item+'_'+key];
                   1396:     if (radios.length) {
                   1397:         var keybox;
                   1398:         if (document.getElementById('deeplink_key_'+item+'_'+key)) {
                   1399:             keybox = document.getElementById('deeplink_key_'+item+'_'+key);
                   1400:         }
                   1401:         var ltidiv;
                   1402:         if (document.getElementById('deeplinkdiv_lti_'+item+'_'+key)) {
                   1403:             ltidiv = document.getElementById('deeplinkdiv_lti_'+item+'_'+key);
                   1404:         }
                   1405:         for (var i=0; i<radios.length; i++) {
                   1406:             if (radios[i].checked) {
                   1407:                 if (radios[i].value == 'lti') {
                   1408:                     ltidiv.style.display = 'inline-block';
                   1409:                     keybox.type = 'hidden';
                   1410:                     keybox.value = '';
                   1411:                 } else {
                   1412:                     if (ltidiv != '') {
                   1413:                         ltidiv.style.display = 'none';
                   1414:                         form['deeplink_lti_'+key].selectedIndex = 0;
                   1415:                     }
                   1416:                     if (radios[i].value == 'key') {
                   1417:                         keybox.type = 'text';
                   1418:                     } else {
                   1419:                         keybox.type = 'hidden';
                   1420:                     }
                   1421:                 }
                   1422:             }
                   1423:         }
                   1424:     }
                   1425: }
                   1426: END
                   1427: 
                   1428: }
                   1429: 
1.561     damieng  1430: # Prints HTML page start for table mode.
                   1431: # @param {Apache2::RequestRec} $r - the Apache request
                   1432: # @param {string} $psymb - resource symb
                   1433: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1434: sub startpage {
1.531     raeburn  1435:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1436: 
1.515     raeburn  1437:     my %loaditems = (
                   1438:                       'onload'   => "group_or_section('cgroup')",
                   1439:                     );
                   1440:     if (!$psymb) {
1.523     raeburn  1441:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1442:     }
1.280     albertel 1443: 
1.560     damieng  1444:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1445:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1446:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1447:             text=>"Problem Parameters"});
1.414     droeschl 1448:     } else {
1.560     damieng  1449:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1450:             text=>"Table Mode",
                   1451:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1452:     }
1.523     raeburn  1453:     my $js = &page_js().'
                   1454: <script type="text/javascript">
                   1455: // <![CDATA[
                   1456: '.
                   1457:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1458: // ]]>
                   1459: </script>
                   1460: ';
1.446     bisitz   1461:     my $start_page =
1.523     raeburn  1462:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1463:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1464:     my $breadcrumbs =
1.473     amueller 1465:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1466:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1467:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1468:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1469:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1470:     $r->print(<<ENDHEAD);
1.193     albertel 1471: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1472: <input type="hidden" value="" name="pres_value" />
                   1473: <input type="hidden" value="" name="pres_type" />
                   1474: <input type="hidden" value="" name="pres_marker" />
                   1475: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1476: <input type="hidden" value="$escfilter" name="filter" />
                   1477: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1478: ENDHEAD
                   1479: }
                   1480: 
1.209     www      1481: 
1.561     damieng  1482: # Prints a row for table mode (except for the tr start).
                   1483: # Every time a hash reference is passed, a single entry is used, so print_row
                   1484: # could just use these values, but why make it simple when it can be complicated ?
                   1485: #
                   1486: # @param {Apache2::RequestRec} $r - the Apache request
                   1487: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1488: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1489: # @param {hash reference} $name - parameter key -> parameter name
1.566     damieng  1490: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561     damieng  1491: # @param {string} $rid - resource id
                   1492: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1493: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1494: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1495: # @param {string} $defbgone - user level and other levels background color
                   1496: # @param {string} $defbgtwo - section level background color, also used for part number
                   1497: # @param {string} $defbgthree - group level background color
                   1498: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1499: # @param {string} $uname - user name
                   1500: # @param {string} $udom - user domain
                   1501: # @param {string} $csec - section name
                   1502: # @param {string} $cgroup - group name
                   1503: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1504: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.582     raeburn  1505: # @param {boolean} $readonly - true if no editing allowed.
                   1506: # @param {array reference} - $recurseup - list of maps containing current one, ending at top-level.
                   1507: # @param {hash reference} - $maptitles - - hash map id or src -> map title 
                   1508: # @param {hash reference} - $allmaps_inverted - hash map src -> map pc
                   1509: # @param {scalar reference} - $reclinks - number of "parameter in effect" cells with link to map where recursive param was set 
1.44      albertel 1510: sub print_row {
1.201     www      1511:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568     raeburn  1512:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
1.582     raeburn  1513:     $readonly,$recurseup,$maptitles,$allmaps_inverted,$reclinks)=@_;
1.275     raeburn  1514:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1515:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1516:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.582     raeburn  1517:     my $numlinks = 0;
1.553     raeburn  1518: 
1.560     damieng  1519:     # get the values for the parameter in cascading order
                   1520:     # empty levels will remain empty
1.44      albertel 1521:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1522:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1523:     # get the type for the parameters
                   1524:     # problem: these may not be set for all levels
1.66      www      1525:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1526:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1527:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1528:     # cascade down manually
1.182     albertel 1529:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1530:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1531:         if ($typeoutpar[$i]) {
1.66      www      1532:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1533:         } else {
1.66      www      1534:             $typeoutpar[$i]=$cascadetype;
                   1535:         }
                   1536:     }
1.57      albertel 1537:     my $parm=$$display{$which};
                   1538: 
1.203     www      1539:     if ($parmlev eq 'full') {
1.419     bisitz   1540:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1541:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1542:     } else {
1.57      albertel 1543:         $parm=~s|\[.*\]\s||g;
                   1544:     }
1.231     www      1545:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1546:     if ($automatic) {
1.560     damieng  1547:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1548:     }
1.427     bisitz   1549:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1550: 
1.44      albertel 1551:     my $thismarker=$which;
                   1552:     $thismarker=~s/^parameter\_//;
                   1553:     my $mprefix=$rid.'&'.$thismarker.'&';
1.582     raeburn  1554:     my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1555:     my ($othergrp,$grp_parm,$controlgrp,$effective_parm,$effparm_rec,$effparm_level,
1.588     raeburn  1556:         $eff_groupparm,$recurse_check,$recursinfo,$extra);
1.582     raeburn  1557:     if ((ref($recurseup) eq 'ARRAY') && (@{$recurseup} > 0)) {
                   1558:         if ($result eq '') {
                   1559:             $recurse_check = 1;
                   1560:         } elsif (($uname ne '') && ($result > 3)) {
                   1561:             $recurse_check = 1;
                   1562:         } elsif (($cgroup ne '') && ($result > 7)) {
                   1563:             $recurse_check = 1;
                   1564:         } elsif (($csec ne '') && ($result > 11)) {
                   1565:             $recurse_check = 1;
                   1566:         } elsif ($result > 17) {
                   1567:             $recurse_check = 1;
                   1568:         }
                   1569:         if ($recurse_check) {
                   1570:             my $what = $$part{$which}.'.'.$$name{$which};
                   1571:             my $prefix;
                   1572:             if (($uname ne '') && ($udom ne '')) {
                   1573:                 my $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
                   1574:                 $prefix = $env{'request.course.id'};
                   1575:                 $recursinfo = &get_recursive($recurseup,$useropt,$what,$prefix);
                   1576:                 if (ref($recursinfo) eq 'ARRAY') {
                   1577:                     $effparm_rec = 1;
                   1578:                     $effparm_level = &mt('user: [_1]',$uname);
                   1579:                 }
                   1580:             }
                   1581:             if (($cgroup ne '') && (!$effparm_rec)) {
                   1582:                 $prefix = $env{'request.course.id'}.'.['.$cgroup.']';
                   1583:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1584:                 if (ref($recursinfo) eq 'ARRAY') {
                   1585:                     $effparm_rec = 1;
                   1586:                     $effparm_level = &mt('group: [_1]',$cgroup);
                   1587:                 }
                   1588:             }
                   1589:             if (($csec ne '') && (!$effparm_rec)) {
                   1590:                 $prefix = $env{'request.course.id'}.'.['.$csec.']';
                   1591:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix);
                   1592:                 if (ref($recursinfo) eq 'ARRAY') {
                   1593:                     $effparm_rec = 1;
                   1594:                     $effparm_level = &mt('section: [_1]',$csec);
                   1595:                 }
                   1596:             }
                   1597:             if (!$effparm_rec) {
                   1598:                 $prefix = $env{'request.course.id'};
                   1599:                 $recursinfo = &get_recursive($recurseup,$courseopt,$what,$prefix); 
                   1600:                 if (ref($recursinfo) eq 'ARRAY') {
                   1601:                     $effparm_rec = 1;
                   1602:                 }
                   1603:             }
                   1604:         }
                   1605:     }
                   1606:     if ((!$effparm_rec) && ($result == 17 || $result == 11 || $result == 7 || $result == 3)) {
                   1607:         $effparm_rec = 1;
                   1608:     }
                   1609:     if ((!$effparm_rec) && 
                   1610:         (($$name{$which} eq 'encrypturl') || ($$name{$which} eq 'hiddenresource')) && 
                   1611:         ($result == 16 || $result == 10 || $result == 6 || $result == 2)) {
1.578     raeburn  1612:         $effparm_rec = 1;
                   1613:     }
1.588     raeburn  1614:     if ($parmname eq 'deeplink') {
                   1615:         my %posslti;
                   1616:         my %lti =
                   1617:             &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   1618:                                             'provider');
                   1619:         foreach my $item (keys(%lti)) {
                   1620:             if (ref($lti{$item}) eq 'HASH') {
                   1621:                 unless ($lti{$item}{'requser'}) {
                   1622:                     $posslti{$item} = $lti{$item}{'consumer'};
                   1623:                 }
                   1624:             }
                   1625:         }
                   1626:         if (keys(%posslti)) {
                   1627:             $extra = 'lti_';
                   1628:             foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   1629:                 $extra .= $lti.':'.&js_escape($posslti{$lti}).',';
                   1630:             }
                   1631:             $extra =~ s/,$//;
                   1632:         }
                   1633:     }
1.57      albertel 1634:     if ($parmlev eq 'general') {
                   1635:         if ($uname) {
1.588     raeburn  1636:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.269     raeburn  1637:         } elsif ($cgroup) {
1.588     raeburn  1638:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
1.57      albertel 1639:         } elsif ($csec) {
1.588     raeburn  1640:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1641:         } else {
1.588     raeburn  1642:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.57      albertel 1643:         }
                   1644:     } elsif ($parmlev eq 'map') {
                   1645:         if ($uname) {
1.588     raeburn  1646:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.269     raeburn  1647:         } elsif ($cgroup) {
1.588     raeburn  1648:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
1.57      albertel 1649:         } elsif ($csec) {
1.588     raeburn  1650:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1651:         } else {
1.588     raeburn  1652:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
1.57      albertel 1653:         }
                   1654:     } else {
1.275     raeburn  1655:         if ($uname) {
                   1656:             if (@{$usersgroups} > 1) {
1.582     raeburn  1657:                 (my $coursereply,$othergrp,$grp_parm,$controlgrp,my $grp_is_rec) =
1.580     raeburn  1658:                     &check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1659:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.582     raeburn  1660:                 if (($coursereply) && ($result > 4)) {
1.275     raeburn  1661:                     if (defined($controlgrp)) {
                   1662:                         if ($cgroup ne $controlgrp) {
1.582     raeburn  1663:                             $eff_groupparm = $grp_parm;
                   1664:                             undef($result);
                   1665:                             undef($effparm_rec);
                   1666:                             if ($grp_is_rec) {
                   1667:                                  $effparm_rec = 1;
                   1668:                             }
1.275     raeburn  1669:                         }
                   1670:                     }
                   1671:                 }
                   1672:             }
                   1673:         }
1.57      albertel 1674: 
1.588     raeburn  1675:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1676:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1677:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1678:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1679:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1680: 
                   1681:         if ($csec) {
1.588     raeburn  1682:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1683:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1684:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1685:         }
1.269     raeburn  1686: 
                   1687:         if ($cgroup) {
1.588     raeburn  1688:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,'',$extra);
                   1689:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1,$extra);
                   1690:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly,'',$extra);
1.269     raeburn  1691:         }
1.446     bisitz   1692: 
1.548     raeburn  1693:         if ($uname) {
1.275     raeburn  1694:             if ($othergrp) {
                   1695:                 $r->print($othergrp);
                   1696:             }
1.588     raeburn  1697:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
                   1698:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1,$extra);
                   1699:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,'',$extra);
1.548     raeburn  1700:         }
1.57      albertel 1701:     } # end of $parmlev if/else
1.582     raeburn  1702:     if (ref($recursinfo) eq 'ARRAY') {
                   1703:         my $rectitle = &mt('recursive');
                   1704:         if ((ref($maptitles) eq 'HASH') && (exists($maptitles->{$recursinfo->[2]}))) {
                   1705:             if ((ref($allmaps_inverted) eq 'HASH') && (exists($allmaps_inverted->{$recursinfo->[2]}))) {
                   1706:                 $rectitle = &mt('set in: [_1]','"'.
                   1707:                                 '<a href="javascript:pjumprec('."'".$allmaps_inverted->{$recursinfo->[2]}."',".
                   1708:                                                               "'$parmname','$$part{$which}'".');">'.
                   1709:                                 $maptitles->{$recursinfo->[2]}.'</a>"');
                   1710:               
                   1711:                 $numlinks ++;
                   1712:             }
                   1713:         }
                   1714:         my ($parmname)=($thismarker=~/\_([^\_]+)$/);
                   1715:         $effective_parm = &valout($recursinfo->[0],$recursinfo->[1],$parmname);
                   1716:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1717:                   '<br /><span class="LC_parm_recursive">'.$rectitle.'&nbsp;'.
                   1718:                   $effparm_level.'</span></td>');
                   1719:     } else {
                   1720:         if ($result) {
                   1721:             $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$parmname);
                   1722:         }
                   1723:         if ($eff_groupparm) {
                   1724:             $effective_parm = $eff_groupparm;
                   1725:         }
                   1726:         $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1727:                   ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
                   1728:                                 '</span>':'').'</td>');
                   1729:     }
1.203     www      1730:     if ($parmlev eq 'full') {
1.136     albertel 1731:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1732:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1733:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1734:         if (!defined($sessionvaltype)) {
                   1735:             $sessionvaltype=$$defaulttype{$which};
                   1736:         }
1.419     bisitz   1737:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.554     raeburn  1738:                   &valout($sessionval,$sessionvaltype,$$name{$which}).'&nbsp;'.
1.57      albertel 1739:                   '</font></td>');
1.136     albertel 1740:     }
1.44      albertel 1741:     $r->print('</tr>');
1.57      albertel 1742:     $r->print("\n");
1.582     raeburn  1743:     if (($numlinks) && (ref($reclinks))) {
                   1744:         $$reclinks = $numlinks;
                   1745:     }
1.44      albertel 1746: }
1.59      matthew  1747: 
1.561     damieng  1748: # Prints a cell for table mode.
                   1749: #
                   1750: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1751: # Also, it would make more sense to pass the display for this cell rather
                   1752: # than the full display hash and the key to use.
                   1753: #
                   1754: # @param {Apache2::RequestRec} $r - the Apache request
                   1755: # @param {integer} $which - level
                   1756: # @param {string} $defbg - cell background color
                   1757: # @param {integer} $result - the most specific level that is defined for that parameter
                   1758: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1759: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1760: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1761: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1762: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1763: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1764: # @param {boolean} $readonly -true if editing not allowed.
1.588     raeburn  1765: # @param {boolean} $ismaplevel - true if level is for a map.
                   1766: # @param {strring} $extra - extra informatio to pass to plink.
1.44      albertel 1767: sub print_td {
1.578     raeburn  1768:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
1.588     raeburn  1769:         $noeditgrp,$readonly,$ismaplevel,$extra)=@_;
1.578     raeburn  1770:     my ($ineffect,$recursive,$currval,$currtype,$currlevel);
                   1771:     $ineffect = 0;
                   1772:     $currval = $$outpar[$which];
                   1773:     $currtype = $$typeoutpar[$which];
                   1774:     $currlevel = $which;
                   1775:     if (($result) && ($result == $which)) {
                   1776:         $ineffect = 1;
                   1777:     } 
                   1778:     if ($ismaplevel) {
                   1779:         if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
                   1780:             if (($result) && ($result == $which)) {
                   1781:                 $recursive = 1;
                   1782:             }
                   1783:         } elsif ($$outpar[$which+1] ne '') {
                   1784:             $recursive = 1;
                   1785:             $currlevel = $which+1;
                   1786:             $currval = $$outpar[$currlevel];
                   1787:             $currtype = $$typeoutpar[$currlevel];
                   1788:             if (($result) && ($result == $currlevel)) {
                   1789:                 $ineffect = 1;
                   1790:             }
                   1791:         }
                   1792:     }
                   1793:     $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419     bisitz   1794:               ';" align="center">');
1.437     raeburn  1795:     my $nolink = 0;
1.568     raeburn  1796:     if ($readonly) {
1.552     raeburn  1797:         $nolink = 1;
1.568     raeburn  1798:     } else { 
1.578     raeburn  1799:         if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553     raeburn  1800:             $nolink = 1;
1.568     raeburn  1801:         } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533     raeburn  1802:             $nolink = 1;
1.568     raeburn  1803:         } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
                   1804:             if ($noeditgrp) {
                   1805:                 $nolink = 1;
                   1806:             }
                   1807:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1808:             if ($which > 4) {
                   1809:                 $nolink = 1;
                   1810:             }
                   1811:         } elsif ($mprefix =~ /examcode\&$/) {
                   1812:             unless ($which == 2) {
                   1813:                 $nolink = 1;
                   1814:             }
1.533     raeburn  1815:         }
1.437     raeburn  1816:     }
                   1817:     if ($nolink) {
1.577     raeburn  1818:         my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.578     raeburn  1819:         $r->print(&valout($currval,$currtype,$parmname));
1.114     www      1820:     } else {
1.578     raeburn  1821:         $r->print(&plink($currtype,
                   1822:                          $$display{$value},$currval,
1.588     raeburn  1823:                          $mprefix.$currlevel,'parmform.pres','psub',$recursive,
                   1824:                          $extra));
1.114     www      1825:     }
                   1826:     $r->print('</td>'."\n");
1.57      albertel 1827: }
                   1828: 
1.561     damieng  1829: # Returns HTML and other info for the cell added when a user is selected
                   1830: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1831: #
                   1832: # @param {string} $what - parameter part.'.'.parameter name
                   1833: # @param {string} $rid - resource id
                   1834: # @param {string} $cgroup - group name
                   1835: # @param {string} $defbg - cell background color
                   1836: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1837: # @param {integer} $result - level
                   1838: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
1.582     raeburn  1839: # @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  1840: sub check_other_groups {
                   1841:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1842:     my $courseid = $env{'request.course.id'};
                   1843:     my $output;
                   1844:     my $symb = &symbcache($rid);
                   1845:     my $symbparm=$symb.'.'.$what;
                   1846:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1847:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1848:     my $mapparm=$map.'___(all).'.$what;
                   1849:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1850:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1851:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1852:     my $bgcolor = $defbg;
1.582     raeburn  1853:     my ($grp_parm,$grp_is_rec);
1.446     bisitz   1854:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.582     raeburn  1855:         my ($parmname) = ($what =~ /\.([^.]+)$/);
1.275     raeburn  1856:         if ($result > 3) {
1.419     bisitz   1857:             $bgcolor = '#AAFFAA';
1.275     raeburn  1858:         }
1.582     raeburn  1859:         $grp_parm = &valout($coursereply,$resulttype,$parmname);
1.419     bisitz   1860:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1861:         if ($resultgroup && $resultlevel) {
1.582     raeburn  1862:             if ($resultlevel eq 'recursive') {
                   1863:                 $resultlevel = 'map/folder';
                   1864:                 $grp_is_rec = 1;
                   1865:             }
                   1866:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm.
                   1867:                        ($grp_is_rec?'<span class="LC_parm_recursive">'.&mt('recursive').'</span>':'');
                   1868:              
1.275     raeburn  1869:         } else {
                   1870:             $output .= '&nbsp;';
                   1871:         }
                   1872:         $output .= '</td>';
                   1873:     } else {
1.419     bisitz   1874:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1875:     }
1.582     raeburn  1876:     return ($coursereply,$output,$grp_parm,$resultgroup,$grp_is_rec);
1.275     raeburn  1877: }
                   1878: 
1.561     damieng  1879: # Looks for a group with a defined parameter for given user and parameter.
1.580     raeburn  1880: # Used by check_other_groups.
1.561     damieng  1881: #
                   1882: # @param {string} $courseid - the course id
                   1883: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1884: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1885: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1886: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1887: # @param {string} $what - parameter part.'.'.parameter name
                   1888: # @param {hash reference} $courseopt - course parameters hash
                   1889: # @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  1890: sub parm_control_group {
1.556     raeburn  1891:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1892:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1893:     my $grpfound = 0;
1.556     raeburn  1894:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1895:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1896:     foreach my $group (@{$usersgroups}) {
                   1897:         if ($grpfound) { last; }
                   1898:         for (my $i=0; $i<@levels; $i++) {
                   1899:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1900:             if (defined($$courseopt{$item})) {
                   1901:                 $coursereply = $$courseopt{$item};
                   1902:                 $resultitem = $item;
                   1903:                 $resultgroup = $group;
                   1904:                 $resultlevel = $levelnames[$i];
                   1905:                 $resulttype = $$courseopt{$item.'.type'};
                   1906:                 $grpfound = 1;
                   1907:                 last;
                   1908:             }
                   1909:         }
                   1910:     }
                   1911:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1912: }
1.201     www      1913: 
1.63      bowersj2 1914: 
                   1915: 
1.562     damieng  1916: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1917: # All the parameters are references and are filled by the sub.
                   1918: #
1.566     damieng  1919: # @param {array reference} $ids - resource and map ids
                   1920: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
                   1921: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562     damieng  1922: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1923: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566     damieng  1924: # @param {hash reference} $allmaps - hash map pc -> map src
                   1925: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
                   1926: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
                   1927: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
                   1928: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562     damieng  1929: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1930: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1931: sub extractResourceInformation {
                   1932:     my $ids = shift;
                   1933:     my $typep = shift;
                   1934:     my $keyp = shift;
                   1935:     my $allparms = shift;
                   1936:     my $allparts = shift;
                   1937:     my $allmaps = shift;
                   1938:     my $mapp = shift;
                   1939:     my $symbp = shift;
1.82      www      1940:     my $maptitles=shift;
1.196     www      1941:     my $uris=shift;
1.210     www      1942:     my $keyorder=shift;
1.211     www      1943:     my $defkeytype=shift;
1.196     www      1944: 
1.210     www      1945:     my $keyordercnt=100;
1.63      bowersj2 1946: 
1.196     www      1947:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1948:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1949:     foreach my $resource (@allres) {
1.480     amueller 1950:         my $id=$resource->id();
1.196     www      1951:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1952:         if ($mapid eq '0') { next; }
                   1953:         $$ids[$#$ids+1]=$id;
                   1954:         my $srcf=$resource->src();
                   1955:         $srcf=~/\.(\w+)$/;
                   1956:         $$typep{$id}=$1;
1.584     raeburn  1957:         my $toolsymb;
                   1958:         if ($srcf =~ /ext\.tool$/) {
                   1959:             $toolsymb = $resource->symb();
                   1960:         }
1.480     amueller 1961:         $$keyp{$id}='';
1.196     www      1962:         $$uris{$id}=$srcf;
1.512     foxr     1963: 
1.584     raeburn  1964:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys',$toolsymb))) {
1.480     amueller 1965:             next if ($key!~/^parameter_/);
1.363     albertel 1966: 
1.209     www      1967: # Hidden parameters
1.584     raeburn  1968:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden',$toolsymb) eq 'parm');
1.209     www      1969: #
                   1970: # allparms is a hash of parameter names
                   1971: #
1.584     raeburn  1972:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name',$toolsymb);
1.480     amueller 1973:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1974:                 my ($display,$parmdis);
                   1975:                 $display = &standard_parameter_names($name);
                   1976:                 if ($display eq '') {
1.584     raeburn  1977:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display',$toolsymb);
1.480     amueller 1978:                     $parmdis = $display;
                   1979:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1980:                 } else {
                   1981:                     $parmdis = &mt($display);
                   1982:                 }
                   1983:                 $$allparms{$name}=$parmdis;
                   1984:                 if (ref($defkeytype)) {
                   1985:                     $$defkeytype{$name}=
1.584     raeburn  1986:                     &Apache::lonnet::metadata($srcf,$key.'.type',$toolsymb);
1.480     amueller 1987:                 }
                   1988:             }
1.363     albertel 1989: 
1.209     www      1990: #
                   1991: # allparts is a hash of all parts
                   1992: #
1.584     raeburn  1993:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part',$toolsymb);
1.480     amueller 1994:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1995: #
                   1996: # Remember all keys going with this resource
                   1997: #
1.480     amueller 1998:             if ($$keyp{$id}) {
                   1999:                 $$keyp{$id}.=','.$key;
                   2000:             } else {
                   2001:                 $$keyp{$id}=$key;
                   2002:             }   
1.210     www      2003: #
                   2004: # Put in order
1.446     bisitz   2005: #
1.480     amueller 2006:             unless ($$keyorder{$key}) {
                   2007:                 $$keyorder{$key}=$keyordercnt;
                   2008:                 $keyordercnt++;
                   2009:             }
1.473     amueller 2010:         }
                   2011: 
                   2012: 
1.480     amueller 2013:         if (!exists($$mapp{$mapid})) {
                   2014:             $$mapp{$id}=
                   2015:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   2016:             $$mapp{$mapid}=$$mapp{$id};
                   2017:             $$allmaps{$mapid}=$$mapp{$id};
                   2018:             if ($mapid eq '1') {
1.532     raeburn  2019:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 2020:             } else {
                   2021:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   2022:             }
                   2023:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  2024:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   2025:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   2026:                                                      # are commented out in rev. 1.57
1.473     amueller 2027:         } else {
1.480     amueller 2028:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 2029:         }
1.480     amueller 2030:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 2031:     }
                   2032: }
                   2033: 
1.582     raeburn  2034: sub get_recursive {
                   2035:     my ($recurseup,$resdata,$what,$prefix) = @_; 
                   2036:     if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
                   2037:         foreach my $item (@{$recurseup}) {
                   2038:             my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
                   2039:             if (defined($resdata->{$norecursechk})) {
                   2040:                 if ($what =~ /\.(encrypturl|hiddenresource)$/) {
                   2041:                     my $type = $resdata->{$norecursechk.'.type'};
                   2042:                     return [$resdata->{$norecursechk},$type,$item];
                   2043:                 } else {
                   2044:                     last;
                   2045:                 }
                   2046:             }
                   2047:             my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
                   2048:             if (defined($resdata->{$recursechk})) {
                   2049:                 my $type = $resdata->{$recursechk.'.type'};
                   2050:                 return [$resdata->{$recursechk},$type,$item];
                   2051:             }
                   2052:         }
                   2053:     }
                   2054:     return;
                   2055: }
                   2056: 
1.208     www      2057: 
1.562     damieng  2058: # Tells if a parameter type is a date.
                   2059: #
                   2060: # @param {string} type - parameter type
                   2061: # @returns{boolean} - true if it is a date
1.213     www      2062: sub isdateparm {
                   2063:     my $type=shift;
                   2064:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   2065: }
                   2066: 
1.589   ! raeburn  2067: # Determine if parameter type is specialized string type (i.e.,
        !          2068: # not just string or string_yesno.  
        !          2069: 
        !          2070: sub is_specialstring {
        !          2071:     my $type=shift;
        !          2072:     return (($type=~/^string_/) && ((!$type ne 'string_yesno')));
        !          2073: }
        !          2074: 
1.562     damieng  2075: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 2076: #
1.581     raeburn  2077: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      2078: sub parmmenu {
1.581     raeburn  2079:     my ($r)=@_;
1.208     www      2080:     $r->print(<<ENDSCRIPT);
                   2081: <script type="text/javascript">
1.454     bisitz   2082: // <![CDATA[
1.208     www      2083:     function checkall(value, checkName) {
1.453     schualex 2084: 
                   2085:         var li = "_li";
                   2086:         var displayOverview = "";
                   2087:         
                   2088:         if (value == false) {
                   2089:             displayOverview = "none"
                   2090:         }
                   2091: 
1.562     damieng  2092:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      2093:             ele = document.forms.parmform.elements[i];
                   2094:             if (ele.name == checkName) {
                   2095:                 document.forms.parmform.elements[i].checked=value;
                   2096:             }
                   2097:         }
                   2098:     }
1.210     www      2099: 
                   2100:     function checkthis(thisvalue, checkName) {
1.562     damieng  2101:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      2102:             ele = document.forms.parmform.elements[i];
                   2103:             if (ele.name == checkName) {
1.562     damieng  2104:                 if (ele.value == thisvalue) {
                   2105:                     document.forms.parmform.elements[i].checked=true;
                   2106:                 }
1.210     www      2107:             }
                   2108:         }
                   2109:     }
                   2110: 
                   2111:     function checkdates() {
1.562     damieng  2112:         checkthis('duedate','pscat');
                   2113:         checkthis('opendate','pscat');
                   2114:         checkthis('answerdate','pscat');
1.218     www      2115:     }
                   2116: 
                   2117:     function checkdisset() {
1.562     damieng  2118:         checkthis('discussend','pscat');
                   2119:         checkthis('discusshide','pscat');
                   2120:         checkthis('discussvote','pscat');
1.218     www      2121:     }
                   2122: 
                   2123:     function checkcontdates() {
1.562     damieng  2124:         checkthis('contentopen','pscat');
                   2125:         checkthis('contentclose','pscat');
1.218     www      2126:     }
1.446     bisitz   2127: 
1.210     www      2128:     function checkvisi() {
1.562     damieng  2129:         checkthis('hiddenresource','pscat');
                   2130:         checkthis('encrypturl','pscat');
                   2131:         checkthis('problemstatus','pscat');
                   2132:         checkthis('contentopen','pscat');
                   2133:         checkthis('opendate','pscat');
1.210     www      2134:     }
                   2135: 
                   2136:     function checkparts() {
1.562     damieng  2137:         checkthis('hiddenparts','pscat');
                   2138:         checkthis('display','pscat');
                   2139:         checkthis('ordered','pscat');
1.210     www      2140:     }
                   2141: 
                   2142:     function checkstandard() {
                   2143:         checkall(false,'pscat');
1.562     damieng  2144:         checkdates();
                   2145:         checkthis('weight','pscat');
                   2146:         checkthis('maxtries','pscat');
                   2147:         checkthis('type','pscat');
                   2148:         checkthis('problemstatus','pscat');
1.210     www      2149:     }
                   2150: 
1.454     bisitz   2151: // ]]>
1.208     www      2152: </script>
                   2153: ENDSCRIPT
1.453     schualex 2154: 
1.491     bisitz   2155:     $r->print('<hr />');
1.581     raeburn  2156:     &shortCuts($r);
1.491     bisitz   2157:     $r->print('<hr />');
1.453     schualex 2158: }
1.562     damieng  2159: 
                   2160: # Returns parameter categories.
                   2161: #
                   2162: # @returns {hash} - category name -> title in English
1.465     amueller 2163: sub categories {
                   2164:     return ('time_settings' => 'Time Settings',
                   2165:     'grading' => 'Grading',
                   2166:     'tries' => 'Tries',
                   2167:     'problem_appearance' => 'Problem Appearance',
                   2168:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   2169:     'hiding' => 'Hiding',
                   2170:     'high_level_randomization' => 'High Level Randomization',
                   2171:     'slots' => 'Slots',
                   2172:     'file_submission' => 'File Submission',
                   2173:     'misc' => 'Miscellaneous' ); 
                   2174: }
                   2175: 
1.562     damieng  2176: # Returns the category for each parameter.
                   2177: #
                   2178: # @returns {hash} - parameter name -> category name
1.465     amueller 2179: sub lookUpTableParameter {
                   2180:  
                   2181:     return ( 
                   2182:         'opendate' => 'time_settings',
                   2183:         'duedate' => 'time_settings',
                   2184:         'answerdate' => 'time_settings',
                   2185:         'interval' => 'time_settings',
                   2186:         'contentopen' => 'time_settings',
                   2187:         'contentclose' => 'time_settings',
                   2188:         'discussend' => 'time_settings',
1.560     damieng  2189:         'printstartdate' => 'time_settings',
                   2190:         'printenddate' => 'time_settings',
1.465     amueller 2191:         'weight' => 'grading',
                   2192:         'handgrade' => 'grading',
                   2193:         'maxtries' => 'tries',
                   2194:         'hinttries' => 'tries',
1.503     raeburn  2195:         'randomizeontries' => 'tries',
1.465     amueller 2196:         'type' => 'problem_appearance',
                   2197:         'problemstatus' => 'problem_appearance',
                   2198:         'display' => 'problem_appearance',
                   2199:         'ordered' => 'problem_appearance',
                   2200:         'numbubbles' => 'problem_appearance',
                   2201:         'tol' => 'behaviour_of_input_fields',
                   2202:         'sig' => 'behaviour_of_input_fields',
                   2203:         'turnoffunit' => 'behaviour_of_input_fields',
                   2204:         'hiddenresource' => 'hiding',
                   2205:         'hiddenparts' => 'hiding',
                   2206:         'discusshide' => 'hiding',
                   2207:         'buttonshide' => 'hiding',
                   2208:         'turnoffeditor' => 'hiding',
                   2209:         'encrypturl' => 'hiding',
1.587     raeburn  2210:         'deeplink' => 'hiding',
1.465     amueller 2211:         'randomorder' => 'high_level_randomization',
                   2212:         'randompick' => 'high_level_randomization',
                   2213:         'available' => 'slots',
                   2214:         'useslots' => 'slots',
                   2215:         'availablestudent' => 'slots',
                   2216:         'uploadedfiletypes' => 'file_submission',
                   2217:         'maxfilesize' => 'file_submission',
                   2218:         'cssfile' => 'misc',
                   2219:         'mapalias' => 'misc',
                   2220:         'acc' => 'misc',
                   2221:         'maxcollaborators' => 'misc',
                   2222:         'scoreformat' => 'misc',
1.514     raeburn  2223:         'lenient' => 'grading',
1.519     raeburn  2224:         'retrypartial' => 'tries',
1.521     raeburn  2225:         'discussvote'  => 'misc',
1.584     raeburn  2226:         'examcode' => 'high_level_randomization',
1.575     raeburn  2227:     );
1.465     amueller 2228: }
                   2229: 
1.562     damieng  2230: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2231: #
                   2232: # @param {string} $name - parameter name
                   2233: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2234: sub whatIsMyCategory {
                   2235:     my $name = shift;
                   2236:     my $catList = shift;
                   2237:     my @list;
                   2238:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2239:     my $cat = $lookUpList{$name};
                   2240:     if (defined($cat)) {
                   2241:         if (!defined($$catList{$cat})){
                   2242:             push @list, ($name);
                   2243:             $$catList{$cat} = \@list;
                   2244:         } else {
                   2245:             push @{${$catList}{$cat}}, ($name);     
                   2246:         }
                   2247:     } else {
                   2248:         if (!defined($$catList{'misc'})){
                   2249:             push @list, ($name);
                   2250:             $$catList{'misc'} = \@list;
                   2251:         } else {
                   2252:             push @{${$catList}{'misc'}}, ($name);     
                   2253:         }
                   2254:     }        
                   2255: }
                   2256: 
1.562     damieng  2257: # Sorts parameter names based on appearance order.
                   2258: #
                   2259: # @param {array reference} name - array reference of parameter names
                   2260: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2261: # @returns {Array} - array of parameter names
1.465     amueller 2262: sub keysindisplayorderCategory {
                   2263:     my ($name,$keyorder)=@_;
                   2264:     return sort {
1.473     amueller 2265:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2266:     } ( @{$name});
                   2267: }
                   2268: 
1.562     damieng  2269: # Returns a hash category name -> order, starting at 1 (integer)
                   2270: #
                   2271: # @returns {hash}
1.467     amueller 2272: sub category_order {
                   2273:     return (
                   2274:         'time_settings' => 1,
                   2275:         'grading' => 2,
                   2276:         'tries' => 3,
                   2277:         'problem_appearance' => 4,
                   2278:         'hiding' => 5,
                   2279:         'behaviour_of_input_fields' => 6,
                   2280:         'high_level_randomization'  => 7,
                   2281:         'slots' => 8,
                   2282:         'file_submission' => 9,
                   2283:         'misc' => 10
                   2284:     );
                   2285: 
                   2286: }
1.453     schualex 2287: 
1.562     damieng  2288: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2289: #
                   2290: # @param {Apache2::RequestRec} $r - the Apache request
                   2291: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2292: # @param {array reference} $pscat - list of selected parameter names
                   2293: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2294: sub parmboxes {
                   2295:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2296:     my %categories = &categories();
1.467     amueller 2297:     my %category_order = &category_order();
1.465     amueller 2298:     my %categoryList = (
                   2299:         'time_settings' => [],
                   2300:         'grading' => [],
                   2301:         'tries' => [],
                   2302:         'problem_appearance' => [],
                   2303:         'behaviour_of_input_fields' => [],
                   2304:         'hiding' => [],
                   2305:         'high_level_randomization' => [],
                   2306:         'slots' => [],
                   2307:         'file_submission' => [],
                   2308:         'misc' => [],
1.489     bisitz   2309:     );
1.510     www      2310: 
1.548     raeburn  2311:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2312:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2313:     }
1.453     schualex 2314:     #part to print the parm-list
1.536     raeburn  2315:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2316:         next if (@{$categoryList{$key}} == 0);
                   2317:         next if ($key eq '');
                   2318:         $r->print('<div class="LC_Box LC_400Box">'
                   2319:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2320:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2321:             next if ($tempkey eq '');
1.536     raeburn  2322:             $r->print('<span class="LC_nobreak">'
                   2323:                      .'<label><input type="checkbox" name="pscat" '
                   2324:                      .'value="'.$tempkey.'" ');
                   2325:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2326:                 $r->print( ' checked="checked"');
                   2327:             }
                   2328:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2329:                                                       : $tempkey)
1.536     raeburn  2330:                      .'</label></span><br />'."\n");
1.465     amueller 2331:         }
1.536     raeburn  2332:         $r->print('</div>');
1.465     amueller 2333:     }
1.536     raeburn  2334:     $r->print("\n");
1.453     schualex 2335: }
1.562     damieng  2336: 
                   2337: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2338: #
1.562     damieng  2339: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2340: sub shortCuts {
1.581     raeburn  2341:     my ($r)=@_;
1.453     schualex 2342: 
1.491     bisitz   2343:     # Parameter Selection
                   2344:     $r->print(
                   2345:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2346:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2347:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2348:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2349:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2350:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2351:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2352:        .&Apache::lonhtmlcommon::end_funclist()
                   2353:     );
                   2354: 
                   2355:     # Add Selection for...
                   2356:     $r->print(
                   2357:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2358:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2359:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2360:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2361:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2362:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2363:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2364:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2365:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2366:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2367:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2368:        .&Apache::lonhtmlcommon::end_funclist()
                   2369:     );
1.208     www      2370: }
                   2371: 
1.562     damieng  2372: # Prints HTML to select parts to view (except for the title).
                   2373: # Used by table and overview modes.
                   2374: #
                   2375: # @param {Apache2::RequestRec} $r - the Apache request
                   2376: # @param {hash reference} $allparts - hash parameter part -> part title
                   2377: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2378: sub partmenu {
1.446     bisitz   2379:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2380:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2381:     if ($selsize > 8) {
                   2382:         $selsize = 8;
                   2383:     }
1.446     bisitz   2384: 
1.523     raeburn  2385:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2386:     $r->print('<option value="all"');
1.562     damieng  2387:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2388:     $r->print('>'.&mt('All Parts').'</option>');
                   2389:     my %temphash=();
                   2390:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2391:     foreach my $tempkey (sort {
1.560     damieng  2392:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2393:             } keys(%{$allparts})) {
                   2394:         unless ($tempkey =~ /\./) {
                   2395:             $r->print('<option value="'.$tempkey.'"');
                   2396:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2397:                 $r->print(' selected="selected"');
                   2398:             }
                   2399:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2400:         }
1.208     www      2401:     }
1.446     bisitz   2402:     $r->print('</select>');
1.209     www      2403: }
                   2404: 
1.562     damieng  2405: # Prints HTML to select a user and/or a group.
                   2406: # Used by table mode.
                   2407: #
                   2408: # @param {Apache2::RequestRec} $r - the Apache request
                   2409: # @param {string} $uname - selected user name
                   2410: # @param {string} $id - selected Student/Employee ID
                   2411: # @param {string} $udom - selected user domain
                   2412: # @param {string} $csec - selected section name
                   2413: # @param {string} $cgroup - selected group name
                   2414: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2415: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2416: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2417: sub usermenu {
1.553     raeburn  2418:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2419:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2420:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2421:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2422: 
1.209     www      2423:     my $sections='';
1.300     albertel 2424:     my %sectionhash = &Apache::loncommon::get_sections();
                   2425: 
1.269     raeburn  2426:     my $groups;
1.553     raeburn  2427:     my %grouphash;
                   2428:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2429:         %grouphash = &Apache::longroup::coursegroups();
                   2430:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2431:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2432:     }
1.299     albertel 2433: 
1.412     bisitz   2434:     my $g_s_header='';
                   2435:     my $g_s_footer='';
1.446     bisitz   2436: 
1.552     raeburn  2437:     my $currsec = $env{'request.course.sec'};
                   2438:     if ($currsec) {
                   2439:         $sections=&mt('Section:').' '.$currsec;
                   2440:         if (%grouphash) {
                   2441:             $sections .= ';'.('&nbsp;' x2);
                   2442:         }
                   2443:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2444:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2445:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2446:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2447:         }
                   2448:         $sections .= '>';
1.548     raeburn  2449:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2450:         $sections.='<option value="'.$section.'" '.
                   2451:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2452:                                                               '</option>';
1.209     www      2453:         }
                   2454:         $sections.='</select>';
1.269     raeburn  2455:     }
1.412     bisitz   2456: 
1.552     raeburn  2457:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2458:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2459:         $sections .= qq|
                   2460: <script type="text/javascript">
1.454     bisitz   2461: // <![CDATA[
1.269     raeburn  2462: function group_or_section(caller) {
                   2463:    if (caller == "cgroup") {
                   2464:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2465:            document.parmform.csec.selectedIndex = 0;
                   2466:        }
                   2467:    } else {
                   2468:        if (document.parmform.csec.selectedIndex != 0) {
                   2469:            document.parmform.cgroup.selectedIndex = 0;
                   2470:        }
                   2471:    }
                   2472: }
1.454     bisitz   2473: // ]]>
1.269     raeburn  2474: </script>
                   2475: |;
1.554     raeburn  2476:     } else {
1.269     raeburn  2477:         $sections .= qq|
                   2478: <script type="text/javascript">
1.454     bisitz   2479: // <![CDATA[
1.269     raeburn  2480: function group_or_section(caller) {
                   2481:     return;
                   2482: }
1.454     bisitz   2483: // ]]>
1.269     raeburn  2484: </script>
                   2485: |;
1.446     bisitz   2486:     }
1.299     albertel 2487: 
                   2488:     if (%grouphash) {
1.412     bisitz   2489:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2490:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2491:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2492:         }
                   2493:         $groups .= '>';
1.548     raeburn  2494:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2495:             $groups.='<option value="'.$grp.'" ';
                   2496:             if ($grp eq $cgroup) {
                   2497:                 unless ((defined($uname)) && ($grp eq '')) {
                   2498:                     $groups .=  'selected="selected" ';
                   2499:                 }
                   2500:             } elsif (!defined($cgroup)) {
                   2501:                 if (@{$usersgroups} == 1) {
                   2502:                     if ($grp eq $$usersgroups[0]) {
                   2503:                         $groups .=  'selected="selected" ';
                   2504:                     }
                   2505:                 }
                   2506:             }
                   2507:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2508:         }
                   2509:         $groups.='</select>';
                   2510:     }
1.412     bisitz   2511: 
1.445     neumanie 2512:     if (%sectionhash || %grouphash) {
1.446     bisitz   2513:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2514:         $r->print($sections.$groups);
1.448     bisitz   2515:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2516:     } else {
                   2517:         $r->print($sections); 
1.445     neumanie 2518:     }
1.446     bisitz   2519: 
                   2520:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2521:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2522:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2523:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2524:                  ,$chooseopt));
1.209     www      2525: }
                   2526: 
1.562     damieng  2527: # Prints HTML to select parameters from a list of all parameters.
                   2528: # Uses parmmenu and parmboxes.
                   2529: # Used by table and overview modes.
1.468     amueller 2530: #
1.562     damieng  2531: # @param {Apache2::RequestRec} $r - the Apache request
                   2532: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2533: # @param {array reference} $pscat - list of selected parameter names
                   2534: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2535: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2536: sub displaymenu {
1.581     raeburn  2537:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2538: 
1.445     neumanie 2539:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2540:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2541: 
1.581     raeburn  2542:     &parmmenu($r);
1.536     raeburn  2543:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2544:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2545:     $r->print(&Apache::loncommon::end_scrollbox());
                   2546: 
                   2547:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2548:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2549:  
1.209     www      2550: }
                   2551: 
1.562     damieng  2552: # Prints HTML to select a map.
                   2553: # Used by table mode and overview mode.
                   2554: #
                   2555: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2556: # @param {hash reference} $allmaps - hash map pc -> map src
                   2557: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2558: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2559: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2560: sub mapmenu {
1.499     raeburn  2561:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2562:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2563:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2564:     my $tree=[];
                   2565:     my $treeinfo={};
                   2566:     if (defined($navmap)) {
1.499     raeburn  2567:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2568:         my $curRes;
                   2569:         my $depth = 0;
1.468     amueller 2570:         my %parent = ();
                   2571:         my $startcount = 5;
                   2572:         my $lastcontainer = $startcount;
                   2573: # preparing what is to show ...
1.461     neumanie 2574:         while ($curRes = $it->next()) {
                   2575:             if ($curRes == $it->BEGIN_MAP()) {
                   2576:                 $depth++;
1.468     amueller 2577:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2578:             }
                   2579:             if ($curRes == $it->END_MAP()) {
                   2580:                 $depth--;
1.468     amueller 2581:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2582:             }
                   2583:             if (ref($curRes)) {
1.468     amueller 2584:                 my $symb = $curRes->symb();
                   2585:                 my $ressymb = $symb;
1.461     neumanie 2586:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2587:                     my $type = 'sequence';
                   2588:                     if ($curRes->is_page()) {
                   2589:                         $type = 'page';
                   2590:                     }
                   2591:                     my $id= $curRes->id();
1.468     amueller 2592:                     my $srcf = $curRes->src();
                   2593:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2594:                     if(!exists($treeinfo->{$id})) {
                   2595:                         push(@$tree,$id);
1.473     amueller 2596:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2597:                         $treeinfo->{$id} = {
1.461     neumanie 2598:                                     depth => $depth,
                   2599:                                     type  => $type,
1.468     amueller 2600:                                     name  => $resource_name,
                   2601:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2602:                                     };
1.462     neumanie 2603:                     }
1.461     neumanie 2604:                 }
                   2605:             }
                   2606:         }
1.462     neumanie 2607:     }
1.473     amueller 2608: # Show it ...    
1.484     amueller 2609:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2610:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2611:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2612:         my $whitespace =
                   2613:             '<img src="'
                   2614:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2615:            .'" alt="" />';
                   2616: 
1.498     bisitz   2617:         # Info about selectable folders/maps
                   2618:         $r->print(
                   2619:             '<div class="LC_info">'
1.508     www      2620:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2621:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2622:            .'</div>'
                   2623:         );
                   2624: 
1.536     raeburn  2625:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2626:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2627: 
1.498     bisitz   2628:         # Display row: "All Maps or Folders"
                   2629:         $r->print(
1.523     raeburn  2630:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2631:            .'<td>'
                   2632:            .'<label>'
                   2633:            .'<input type="radio" name="pschp"'
1.497     bisitz   2634:         );
                   2635:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2636:         $r->print(
                   2637:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2638:            .&mt('All Maps or Folders')
                   2639:            .'</label>'
                   2640:            .'<hr /></td>'
                   2641:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2642:         );
1.497     bisitz   2643: 
1.532     raeburn  2644:         # Display row: "Main Content"
1.468     amueller 2645:         if (exists($$allmaps{1})) {
1.498     bisitz   2646:             $r->print(
                   2647:                 &Apache::loncommon::start_data_table_row()
                   2648:                .'<td>'
                   2649:                .'<label>'
                   2650:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2651:             );
1.497     bisitz   2652:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2653:             $r->print(
                   2654:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2655:                .$$maptitles{1}
                   2656:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2657:                .'</label>'
                   2658:                .'</td>'
                   2659:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2660:             );
                   2661:         }
1.497     bisitz   2662: 
                   2663:         # Display rows for all course maps and folders
1.468     amueller 2664:         foreach my $id (@{$tree}) {
                   2665:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2666:             # Indentation
1.468     amueller 2667:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2668:             my $indent;
                   2669:             for (my $i = 0; $i < $depth; $i++) {
                   2670:                 $indent.= $whitespace;
                   2671:             }
1.461     neumanie 2672:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2673:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2674:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2675:             }
1.468     amueller 2676:             my $symb_name = $$symbp{$id};
                   2677:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2678:             $symb_name = $tail;
1.498     bisitz   2679:             $r->print(
                   2680:                 &Apache::loncommon::start_data_table_row()
                   2681:                .'<td>'
                   2682:                .'<label>'
1.463     bisitz   2683:             );
1.498     bisitz   2684:             # Only offer radio button for folders/maps which can be parameterized
                   2685:             if ($allmaps_inverted{$symb_name}) {
                   2686:                 $r->print(
                   2687:                     '<input type ="radio" name="pschp"'
                   2688:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2689:                 );
                   2690:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2691:                 $r->print('/>');
                   2692:             } else {
                   2693:                 $r->print($whitespace);
1.461     neumanie 2694:             }
1.498     bisitz   2695:             $r->print(
                   2696:                 $indent.$icon.'&nbsp;'
                   2697:                .$treeinfo->{$id}->{name}
                   2698:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2699:                .'</label>'
                   2700:                .'</td>'
                   2701:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2702:             );
1.461     neumanie 2703:         }
1.497     bisitz   2704: 
1.523     raeburn  2705:         $r->print(&Apache::loncommon::end_data_table().
                   2706:                   '<br style="line-height:2px;" />'.
                   2707:                   &Apache::loncommon::end_scrollbox());
1.209     www      2708:     }
                   2709: }
                   2710: 
1.563     damieng  2711: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2712: # Used by table and overview modes.
                   2713: #
                   2714: # @param {Apache2::RequestRec} $r - the Apache request
                   2715: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2716: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2717: sub levelmenu {
1.446     bisitz   2718:     my ($r,$alllevs,$parmlev)=@_;
                   2719: 
1.548     raeburn  2720:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2721:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2722:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2723:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2724:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2725:         if ($parmlev eq $$alllevs{$lev}) {
                   2726:             $r->print(' selected="selected"');
                   2727:         }
                   2728:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2729:     }
1.446     bisitz   2730:     $r->print("</select>");
1.208     www      2731: }
                   2732: 
1.211     www      2733: 
1.563     damieng  2734: # Returns HTML to select a section (with a select HTML element).
                   2735: # Used by overview mode.
                   2736: #
                   2737: # @param {array reference} $selectedsections - list of selected section ids
                   2738: # @returns {string}
1.211     www      2739: sub sectionmenu {
1.553     raeburn  2740:     my ($selectedsections)=@_;
1.300     albertel 2741:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2742:     return '' if (!%sectionhash);
1.300     albertel 2743: 
1.552     raeburn  2744:     my (@possibles,$disabled);
                   2745:     if ($env{'request.course.sec'} ne '') {
                   2746:         @possibles = ($env{'request.course.sec'});
                   2747:         $selectedsections = [$env{'request.course.sec'}];
                   2748:         $disabled = ' disabled="disabled"';
                   2749:     } else {
                   2750:         @possibles = ('all',sort(keys(%sectionhash)));
                   2751:     }
1.553     raeburn  2752:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2753:     foreach my $s (@possibles) {
1.553     raeburn  2754:         $output .= '    <option value="'.$s.'"';
                   2755:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2756:             $output .= ' selected="selected"';
1.473     amueller 2757:         }
1.553     raeburn  2758:         $output .= '>'."$s</option>\n";
1.300     albertel 2759:     }
1.553     raeburn  2760:     $output .= "</select>\n";
                   2761:     return $output;
1.269     raeburn  2762: }
                   2763: 
1.563     damieng  2764: # Returns HTML to select a group (with a select HTML element).
                   2765: # Used by overview mode.
                   2766: #
                   2767: # @param {array reference} $selectedgroups - list of selected group names
                   2768: # @returns {string}
1.269     raeburn  2769: sub groupmenu {
1.553     raeburn  2770:     my ($selectedgroups)=@_;
                   2771:     my %grouphash;
                   2772:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2773:         %grouphash = &Apache::longroup::coursegroups();
                   2774:     } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  2775:          map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  2776:     }
                   2777:     return '' if (!%grouphash);
1.299     albertel 2778: 
1.553     raeburn  2779:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2780:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2781:         $output .= '    <option value="'.$group.'"';
                   2782:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2783:             $output .=  ' selected="selected"';
1.473     amueller 2784:         }
1.553     raeburn  2785:         $output .= '>'."$group</option>\n";
1.211     www      2786:     }
1.553     raeburn  2787:     $output .= "</select>\n";
                   2788:     return $output;
1.211     www      2789: }
                   2790: 
1.563     damieng  2791: # Returns an array with the given parameter split by comma.
                   2792: # Used by assessparms (table mode).
                   2793: #
                   2794: # @param {string} $keyp - the string to split
                   2795: # @returns {Array<string>}
1.210     www      2796: sub keysplit {
                   2797:     my $keyp=shift;
                   2798:     return (split(/\,/,$keyp));
                   2799: }
                   2800: 
1.563     damieng  2801: # Returns the keys in $name, sorted using $keyorder.
                   2802: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2803: # Used by assessparms (table mode) for resource level.
                   2804: #
                   2805: # @param {hash reference} $name - parameter key -> parameter name
                   2806: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2807: # @returns {Array<string>}
1.210     www      2808: sub keysinorder {
                   2809:     my ($name,$keyorder)=@_;
                   2810:     return sort {
1.560     damieng  2811:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2812:     } (keys(%{$name}));
1.210     www      2813: }
                   2814: 
1.563     damieng  2815: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2816: # Used by assessparms (table mode) for map and general levels.
                   2817: #
                   2818: # @param {hash reference} $name - parameter key -> parameter name
                   2819: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2820: # @returns {Array<string>}
1.236     albertel 2821: sub keysinorder_bytype {
                   2822:     my ($name,$keyorder)=@_;
                   2823:     return sort {
1.563     damieng  2824:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2825:         my $tb=(split('_',$b))[-1];
                   2826:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2827:             return ($a cmp $b);
                   2828:         }
                   2829:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2830:     } (keys(%{$name}));
1.236     albertel 2831: }
                   2832: 
1.563     damieng  2833: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2834: # Used by defaultsetter (parameter settings default actions).
                   2835: #
                   2836: # @param {hash reference} $name - hash parameter name -> parameter title
                   2837: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2838: # @returns {Array<string>}
1.211     www      2839: sub keysindisplayorder {
                   2840:     my ($name,$keyorder)=@_;
                   2841:     return sort {
1.560     damieng  2842:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2843:     } (keys(%{$name}));
1.211     www      2844: }
                   2845: 
1.563     damieng  2846: # Prints HTML with a choice to sort results by realm or student first.
                   2847: # Used by overview mode.
                   2848: #
                   2849: # @param {Apache2::RequestRec} $r - the Apache request
                   2850: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2851: sub sortmenu {
                   2852:     my ($r,$sortorder)=@_;
1.236     albertel 2853:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2854:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2855:        $r->print(' checked="checked"');
1.214     www      2856:     }
                   2857:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2858:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2859:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2860:        $r->print(' checked="checked"');
1.214     www      2861:     }
1.236     albertel 2862:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2863:           '</label>');
1.214     www      2864: }
                   2865: 
1.563     damieng  2866: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2867: #
                   2868: # @returns {hash}
1.211     www      2869: sub standardkeyorder {
                   2870:     return ('parameter_0_opendate' => 1,
1.473     amueller 2871:         'parameter_0_duedate' => 2,
                   2872:         'parameter_0_answerdate' => 3,
                   2873:         'parameter_0_interval' => 4,
                   2874:         'parameter_0_weight' => 5,
                   2875:         'parameter_0_maxtries' => 6,
                   2876:         'parameter_0_hinttries' => 7,
                   2877:         'parameter_0_contentopen' => 8,
                   2878:         'parameter_0_contentclose' => 9,
                   2879:         'parameter_0_type' => 10,
                   2880:         'parameter_0_problemstatus' => 11,
                   2881:         'parameter_0_hiddenresource' => 12,
                   2882:         'parameter_0_hiddenparts' => 13,
                   2883:         'parameter_0_display' => 14,
                   2884:         'parameter_0_ordered' => 15,
                   2885:         'parameter_0_tol' => 16,
                   2886:         'parameter_0_sig' => 17,
                   2887:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2888:         'parameter_0_discussend' => 19,
                   2889:         'parameter_0_discusshide' => 20,
                   2890:         'parameter_0_discussvote' => 21,
1.560     damieng  2891:         'parameter_0_printstartdate'  =>  22,
                   2892:         'parameter_0_printenddate' =>  23);
1.211     www      2893: }
                   2894: 
1.59      matthew  2895: 
1.560     damieng  2896: # Table mode UI.
1.563     damieng  2897: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2898: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2899: #
                   2900: # Parameters used from the request:
                   2901: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2902: # cgroup - selected group
                   2903: # command - 'set': direct access to table mode for a resource
                   2904: # csec - selected section
                   2905: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2906: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2907: # id - student/employee ID
                   2908: # parmlev - selected level (full|map|general)
                   2909: # part - selected part (unused ?)
                   2910: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2911: # pres_type - &&&-separated parameter types
                   2912: # pres_value - &&&-separated parameter values
                   2913: # prevvisit - '1' if the user has submitted the form before
                   2914: # pscat (multiple values) - selected parameter names
1.566     damieng  2915: # pschp - selected map pc, or 'all'
1.563     damieng  2916: # psprt (multiple values) - list of selected parameter parts
                   2917: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2918: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2919: # symb - resource symb (when a single resource is selected)
                   2920: # udom - selected user domain
                   2921: # uname - selected user name
                   2922: # url - used only with command 'set', the resource url
                   2923: #
                   2924: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2925: # @param $parm_permission - ref to hash of permissions
                   2926: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2927: sub assessparms {
1.1       www      2928: 
1.568     raeburn  2929:     my ($r,$parm_permission) = @_;
1.201     www      2930: 
1.512     foxr     2931: 
                   2932: # -------------------------------------------------------- Variable declaration
1.566     damieng  2933:     my @ids=(); # resource and map ids
                   2934:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2935:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2936:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2937:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2938:     my %uris=(); # hash resource/map id -> resource src
                   2939:     my %maptitles=(); # hash map pc or src -> map title
                   2940:     my %allmaps=(); # hash map pc -> map src
1.582     raeburn  2941:     my %allmaps_inverted=(); # hash map src -> map pc
1.563     damieng  2942:     my %alllevs=(); # hash English level title -> value
                   2943: 
                   2944:     my $uname; # selected user name
                   2945:     my $udom; # selected user domain
                   2946:     my $uhome; # server with the user's files, or 'no_host'
                   2947:     my $csec; # selected section name
                   2948:     my $cgroup; # selected group name
                   2949:     my @usersgroups = (); # list of the user groups
1.582     raeburn  2950:     my $numreclinks = 0;
1.446     bisitz   2951: 
1.190     albertel 2952:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2953: 
1.57      albertel 2954:     $alllevs{'Resource Level'}='full';
1.215     www      2955:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2956:     $alllevs{'Course Level'}='general';
                   2957: 
1.563     damieng  2958:     my %allparms; # hash parameter name -> parameter title
                   2959:     my %allparts; # hash parameter part -> part title
1.512     foxr     2960: # ------------------------------------------------------------------------------
                   2961: 
1.210     www      2962: #
                   2963: # Order in which these parameters will be displayed
                   2964: #
1.211     www      2965:     my %keyorder=&standardkeyorder();
                   2966: 
1.512     foxr     2967: #    @ids=();
                   2968: #    %symbp=();       # These seem defined above already.
                   2969: #    %typep=();
1.43      albertel 2970: 
                   2971:     my $message='';
                   2972: 
1.190     albertel 2973:     $csec=$env{'form.csec'};
1.552     raeburn  2974:     if ($env{'request.course.sec'} ne '') {
                   2975:         $csec = $env{'request.course.sec'};    
                   2976:     }
                   2977: 
1.553     raeburn  2978: # Check group privs.
1.269     raeburn  2979:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2980:     my $noeditgrp; 
                   2981:     if ($cgroup ne '') {
                   2982:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2983:             if (($env{'request.course.groups'} eq '') || 
1.585     raeburn  2984:                 (!grep(/^\Q$cgroup\E$/,split(/:/,$env{'request.course.groups'})))) {
1.553     raeburn  2985:                 $noeditgrp = 1;
                   2986:             }
                   2987:         }
                   2988:     }
1.188     www      2989: 
1.190     albertel 2990:     if      ($udom=$env{'form.udom'}) {
                   2991:     } elsif ($udom=$env{'request.role.domain'}) {
                   2992:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2993:     } else {
1.473     amueller 2994:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2995:     }
1.468     amueller 2996:     
1.43      albertel 2997: 
1.134     albertel 2998:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2999:     my $pschp=$env{'form.pschp'};
1.506     www      3000: 
                   3001: 
1.134     albertel 3002:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      3003:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      3004:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 3005: 
1.43      albertel 3006:     my $pssymb='';
1.57      albertel 3007:     my $parmlev='';
1.446     bisitz   3008: 
1.190     albertel 3009:     unless ($env{'form.parmlev'}) {
1.57      albertel 3010:         $parmlev = 'map';
                   3011:     } else {
1.190     albertel 3012:         $parmlev = $env{'form.parmlev'};
1.57      albertel 3013:     }
1.26      www      3014: 
1.29      www      3015: # ----------------------------------------------- Was this started from grades?
                   3016: 
1.560     damieng  3017:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   3018:             (!$env{'form.dis'})) {
1.473     amueller 3019:         my $url=$env{'form.url'};
                   3020:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   3021:         $pssymb=&Apache::lonnet::symbread($url);
                   3022:         if (!@pscat) { @pscat=('all'); }
                   3023:         $pschp='';
1.57      albertel 3024:         $parmlev = 'full';
1.190     albertel 3025:     } elsif ($env{'form.symb'}) {
1.473     amueller 3026:         $pssymb=$env{'form.symb'};
                   3027:         if (!@pscat) { @pscat=('all'); }
                   3028:         $pschp='';
1.57      albertel 3029:         $parmlev = 'full';
1.43      albertel 3030:     } else {
1.473     amueller 3031:         $env{'form.url'}='';
1.43      albertel 3032:     }
                   3033: 
1.190     albertel 3034:     my $id=$env{'form.id'};
1.43      albertel 3035:     if (($id) && ($udom)) {
1.555     raeburn  3036:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 3037:         if ($uname) {
                   3038:             $id='';
                   3039:         } else {
                   3040:             $message=
1.540     bisitz   3041:                 '<p class="LC_warning">'.
                   3042:                 &mt('Unknown ID [_1] at domain [_2]',
                   3043:                     "'".$id."'","'".$udom."'").
                   3044:                 '</p>';
1.473     amueller 3045:         }
1.43      albertel 3046:     } else {
1.473     amueller 3047:         $uname=$env{'form.uname'};
1.43      albertel 3048:     }
                   3049:     unless ($udom) { $uname=''; }
                   3050:     $uhome='';
                   3051:     if ($uname) {
1.473     amueller 3052:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 3053:         if ($uhome eq 'no_host') {
1.473     amueller 3054:             $message=
1.540     bisitz   3055:                 '<p class="LC_warning">'.
                   3056:                 &mt('Unknown user [_1] at domain [_2]',
                   3057:                     "'".$uname."'","'".$udom."'").
                   3058:                 '</p>';
1.473     amueller 3059:             $uname='';
1.12      www      3060:         } else {
1.473     amueller 3061:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   3062:                           $env{'request.course.id'});
                   3063:             if ($csec eq '-1') {
1.540     bisitz   3064:                 $message=
                   3065:                     '<p class="LC_warning">'.
                   3066:                     &mt('User [_1] at domain [_2] not in this course',
                   3067:                         "'".$uname."'","'".$udom."'").
                   3068:                     '</p>';
1.473     amueller 3069:                 $uname='';
                   3070:                 $csec=$env{'form.csec'};
1.269     raeburn  3071:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 3072:             } else {
                   3073:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   3074:                   ('firstname','middlename','lastname','generation','id'));
                   3075:                 $message="\n<p>\n".&mt("Full Name").": ".
                   3076:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   3077:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   3078:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 3079:             }
1.297     raeburn  3080:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  3081:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  3082:             if (@usersgroups > 0) {
1.306     albertel 3083:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  3084:                     $cgroup = $usersgroups[0];
1.297     raeburn  3085:                 }
1.269     raeburn  3086:             }
1.12      www      3087:         }
1.43      albertel 3088:     }
1.2       www      3089: 
1.43      albertel 3090:     unless ($csec) { $csec=''; }
1.269     raeburn  3091:     unless ($cgroup) { $cgroup=''; }
1.12      www      3092: 
1.14      www      3093: # --------------------------------------------------------- Get all assessments
1.446     bisitz   3094:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3095:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3096:                 \%keyorder);
1.63      bowersj2 3097: 
1.582     raeburn  3098:     %allmaps_inverted = reverse(%allmaps);
                   3099: 
1.57      albertel 3100:     $mapp{'0.0'} = '';
                   3101:     $symbp{'0.0'} = '';
1.99      albertel 3102: 
1.14      www      3103: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  3104:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      3105:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   3106:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   3107:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  3108:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3109:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  3110:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   3111:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   3112:         my $totalstored = 0;
1.546     raeburn  3113:         my $now = time;
1.473     amueller 3114:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  3115:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  3116:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  3117:                 next if ($csec ne $env{'request.course.sec'});
                   3118:             }
1.556     raeburn  3119:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  3120:                 next if ($noeditgrp);
1.557     raeburn  3121:             }
                   3122:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   3123:                 $namematch = 'maplevelrecurse';
                   3124:             }
1.556     raeburn  3125:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  3126:                 my (@ok_slots,@fail_slots,@del_slots);
                   3127:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   3128:                 my ($level,@all) =
                   3129:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   3130:                                      $csec,$cgroup,$courseopt);
                   3131:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   3132:                     next if ($slot_name eq '');
                   3133:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   3134:                         push(@ok_slots,$slot_name);
                   3135: 
                   3136:                     } else {
                   3137:                         push(@fail_slots,$slot_name);
                   3138:                     }
                   3139:                 }
                   3140:                 if (@ok_slots) {
                   3141:                     $values[$i] = join(':',@ok_slots);
                   3142:                 } else {
                   3143:                     $values[$i] = '';
                   3144:                 }
                   3145:                 if ($all[$level] ne '') {
                   3146:                     my @existing = split(/:/,$all[$level]);
                   3147:                     foreach my $slot_name (@existing) {
                   3148:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   3149:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   3150:                                 push(@del_slots,$slot_name);
                   3151:                             }
                   3152:                         }
                   3153:                     }
                   3154:                 }
1.554     raeburn  3155:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  3156:                 $name = $1;
1.533     raeburn  3157:                 my $val = $values[$i];
1.549     raeburn  3158:                 my $valmatch = '';
1.533     raeburn  3159:                 if ($name eq 'examcode') {
1.544     raeburn  3160:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   3161:                         $val = 'valid';
                   3162:                     }
1.546     raeburn  3163:                 } elsif ($name eq 'printstartdate') {
                   3164:                     if ($val =~ /^\d+$/) {
                   3165:                         if ($val > $now) {
                   3166:                             $val = 'future';
                   3167:                         }
                   3168:                     } 
                   3169:                 } elsif ($name eq 'printenddate') {
                   3170:                     if ($val =~ /^\d+$/) {
                   3171:                         if ($val < $now) {
                   3172:                             $val = 'past';
                   3173:                         }
                   3174:                     }
1.549     raeburn  3175:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   3176:                     my $stringtype = &get_stringtype($name);
                   3177:                     my $stringmatch = &standard_string_matches($stringtype);
                   3178:                     if (ref($stringmatch) eq 'ARRAY') {
                   3179:                         foreach my $item (@{$stringmatch}) {
                   3180:                             if (ref($item) eq 'ARRAY') {
                   3181:                                 my ($regexpname,$pattern) = @{$item};
                   3182:                                 if ($pattern ne '') {
                   3183:                                     if ($val =~ /$pattern/) {
                   3184:                                         $valmatch = $regexpname;
                   3185:                                         $val = '';
                   3186:                                         last;
                   3187:                                     }
                   3188:                                 }
                   3189:                             }
                   3190:                         }
                   3191:                     }
1.554     raeburn  3192:                 } elsif ($name eq 'interval') {
                   3193:                     my $intervaltype = &get_intervaltype($name);
                   3194:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   3195:                     if (ref($intervalmatch) eq 'ARRAY') {
                   3196:                         foreach my $item (@{$intervalmatch}) {
                   3197:                             if (ref($item) eq 'ARRAY') {
                   3198:                                 my ($regexpname,$pattern) = @{$item};
                   3199:                                 if ($pattern ne '') {
                   3200:                                     if ($val =~ /$pattern/) {
                   3201:                                         $valmatch = $regexpname;
                   3202:                                         $val = '';
                   3203:                                         last;
                   3204:                                     }
                   3205:                                 }
                   3206:                             }
                   3207:                         }
                   3208:                     }
1.533     raeburn  3209:                 }
1.504     raeburn  3210:                 $needsrelease =
1.557     raeburn  3211:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  3212:                 if ($needsrelease) {
1.505     raeburn  3213:                     unless ($got_chostname) {
1.514     raeburn  3214:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  3215:                         $got_chostname = 1;
1.546     raeburn  3216:                     } 
1.557     raeburn  3217:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  3218:                                                           $needsrelease,
                   3219:                                                           $cmajor,$cminor);
1.500     raeburn  3220:                 }
1.437     raeburn  3221:             }
1.504     raeburn  3222:             if ($needsnewer) {
1.557     raeburn  3223:                 undef($namematch);
                   3224:             } else {
                   3225:                 my $currneeded;
                   3226:                 if ($needsrelease) {
                   3227:                     $currneeded = $needsrelease;
                   3228:                 }
                   3229:                 if ($namematch) {
                   3230:                     $needsrelease =
                   3231:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3232:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3233:                         unless ($got_chostname) {
                   3234:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3235:                             $got_chostname = 1;
                   3236:                         }
                   3237:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3238:                                                               $needsrelease,
                   3239:                                                               $cmajor,$cminor);
                   3240:                     } else {
                   3241:                         undef($namematch);
                   3242:                     }
                   3243:                 }
                   3244:             }
                   3245:             if ($needsnewer) {
                   3246:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3247:                                                 $cminor,$needsrelease);
                   3248:             } else {
                   3249:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3250:                                      $values[$i],
                   3251:                                      $types[$i],
                   3252:                                      $uname,$udom,$csec,$cgroup);
                   3253:                 $totalstored ++;
                   3254:             }
1.473     amueller 3255:         }
1.68      www      3256: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3257:         if ($totalstored) {
                   3258:             $message.='<p class="LC_warning">'
                   3259:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3260:                      .&Apache::loncommon::help_open_topic('Caching')
                   3261:                      .'</p>';
                   3262:         }
1.68      www      3263:     }
1.584     raeburn  3264: 
1.57      albertel 3265: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3266:     if ($pscat[0] eq "all") {
                   3267:         @pscat = (keys(%allparms));
                   3268:     }
                   3269:     if (!@pscat) {
                   3270:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3271:     };
                   3272:     if ($psprt[0] eq "all" || !@psprt) {
                   3273:         @psprt = (keys(%allparts));
                   3274:     }
1.2       www      3275: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3276: 
1.531     raeburn  3277:     my $crstype = &Apache::loncommon::course_type();
                   3278:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3279: 
1.548     raeburn  3280:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.589   ! raeburn  3281:             'date_interval','int','float','string','string_lenient',
        !          3282:             'string_examcode','string_deeplink','string_discussvote',
        !          3283:             'string_useslots','string_problemstatus','string_ip',
        !          3284:             'string_questiontype') {
1.473     amueller 3285:         $r->print('<input type="hidden" value="'.
1.563     damieng  3286:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3287:             '" name="recent_'.$item.'" />');
1.44      albertel 3288:     }
1.446     bisitz   3289: 
1.459     bisitz   3290:     # ----- Start Parameter Selection
                   3291: 
                   3292:     # Hide parm selection?
                   3293:     $r->print(<<ENDPARMSELSCRIPT);
                   3294: <script type="text/javascript">
                   3295: // <![CDATA[
                   3296: function parmsel_show() {
1.562     damieng  3297:     document.getElementById('parmsel').style.display = "";
                   3298:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3299: }
                   3300: // ]]>
                   3301: </script>
                   3302: ENDPARMSELSCRIPT
1.474     amueller 3303:     
1.445     neumanie 3304:     if (!$pssymb) {
1.563     damieng  3305:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3306:         my $parmselhiddenstyle=' style="display:none"';
                   3307:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3308:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3309:         } else  {
                   3310:            $r->print('<div id="parmsel">');
                   3311:         }
                   3312: 
1.491     bisitz   3313:         # Step 1
1.523     raeburn  3314:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3315:         $r->print('
1.474     amueller 3316: <script type="text/javascript">
1.523     raeburn  3317: // <![CDATA['.
                   3318:                  &showhide_js().'
1.474     amueller 3319: // ]]>
                   3320: </script>
1.523     raeburn  3321: ');
                   3322:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3323:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3324:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3325:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3326:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3327:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3328:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3329:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3330:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3331: 
                   3332:         # Step 2
1.523     raeburn  3333:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581     raeburn  3334:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3335: 
                   3336:         # Step 3
1.523     raeburn  3337:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3338:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3339:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3340:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3341:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3342: 
                   3343:         # Update Display Button
1.486     www      3344:         $r->print('<p>'
                   3345:              .'<input type="submit" name="dis"'
1.511     www      3346:              .' value="'.&mt('Update Display').'" />'
1.486     www      3347:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3348:              .'</p>');
                   3349:         $r->print('</div>');
1.491     bisitz   3350: 
1.486     www      3351:         # Offer link to display parameter selection again
                   3352:         $r->print('<p id="parmsellink"');
                   3353:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3354:            $r->print($parmselhiddenstyle);
                   3355:         }
                   3356:         $r->print('>'
                   3357:              .'<a href="javascript:parmsel_show()">'
                   3358:              .&mt('Change Parameter Selection')
                   3359:              .'</a>'
                   3360:              .'</p>');
1.44      albertel 3361:     } else {
1.478     amueller 3362:         # parameter screen for a single resource. 
1.486     www      3363:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3364:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3365:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3366:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3367:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3368:                   '<br />');
                   3369:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3370:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3371:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3372:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3373:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3374:         $r->print('<p>'
1.459     bisitz   3375:              .'<input type="submit" name="dis"'
1.511     www      3376:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3377:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3378:              .'</p>');
1.459     bisitz   3379:     }
1.478     amueller 3380:     
1.486     www      3381:     # ----- End Parameter Selection
1.57      albertel 3382: 
1.459     bisitz   3383:     # Display Messages
                   3384:     $r->print('<div>'.$message.'</div>');
1.210     www      3385: 
1.57      albertel 3386: 
                   3387:     my @temp_pscat;
                   3388:     map {
                   3389:         my $cat = $_;
                   3390:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3391:     } @pscat;
                   3392: 
                   3393:     @pscat = @temp_pscat;
                   3394: 
1.548     raeburn  3395: 
1.209     www      3396:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3397: # ----------------------------------------------------------------- Start Table
1.57      albertel 3398:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3399:         my $csuname=$env{'user.name'};
                   3400:         my $csudom=$env{'user.domain'};
1.568     raeburn  3401:         my $readonly = 1;
                   3402:         if ($parm_permission->{'edit'}) {
                   3403:             undef($readonly); 
                   3404:         }
1.57      albertel 3405: 
1.203     www      3406:         if ($parmlev eq 'full') {
1.506     www      3407: #
                   3408: # This produces the cascading table output of parameters
                   3409: #
1.578     raeburn  3410:             my $coursespan=$csec?8:5;
                   3411:             my $userspan=3;
1.560     damieng  3412:             if ($cgroup ne '') {
1.578     raeburn  3413:                 $coursespan += 3;
1.560     damieng  3414:             }
1.473     amueller 3415: 
1.560     damieng  3416:             $r->print(&Apache::loncommon::start_data_table());
                   3417:             #
                   3418:             # This produces the headers
                   3419:             #
                   3420:             $r->print('<tr><td colspan="5"></td>');
                   3421:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3422:             if ($uname) {
1.473     amueller 3423:                 if (@usersgroups > 1) {
1.560     damieng  3424:                     $userspan ++;
                   3425:                 }
                   3426:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3427:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3428:             }
                   3429:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3430:                 'pie'    => "Parameter in Effect",
                   3431:                 'csv'    => "Current Session Value",
1.472     amueller 3432:                 'rl'     => "Resource Level",
1.473     amueller 3433:                 'ic'     => 'in Course',
                   3434:                 'aut'    => "Assessment URL and Title",
                   3435:                 'type'   => 'Type',
                   3436:                 'emof'   => "Enclosing Map or Folder",
                   3437:                 'part'   => 'Part',
1.472     amueller 3438:                 'pn'     => 'Parameter Name',
1.473     amueller 3439:                 'def'    => 'default',
                   3440:                 'femof'  => 'from Enclosing Map or Folder',
                   3441:                 'gen'    => 'general',
                   3442:                 'foremf' => 'for Enclosing Map or Folder',
                   3443:                 'fr'     => 'for Resource'
                   3444:             );
1.560     damieng  3445:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3446: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3447: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3448: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3449: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3450: 
1.10      www      3451: ENDTABLETWO
1.560     damieng  3452:             if ($csec) {
1.578     raeburn  3453:                 $r->print('<th colspan="3">'.
1.560     damieng  3454:                 &mt("in Section")." $csec</th>");
                   3455:             }
                   3456:             if ($cgroup) {
1.578     raeburn  3457:                 $r->print('<th colspan="3">'.
1.472     amueller 3458:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3459:             }
                   3460:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3461: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3462: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3463: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3464: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3465: ENDTABLEHEADFOUR
1.57      albertel 3466: 
1.560     damieng  3467:             if ($csec) {
1.578     raeburn  3468:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3469:             }
1.473     amueller 3470: 
1.560     damieng  3471:             if ($cgroup) {
1.578     raeburn  3472:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3473:             }
                   3474: 
                   3475:             if ($uname) {
                   3476:                 if (@usersgroups > 1) {
                   3477:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3478:                 }
1.578     raeburn  3479:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3480:             }
                   3481: 
                   3482:             $r->print('</tr>');
1.506     www      3483: #
                   3484: # Done with the headers
                   3485: # 
1.560     damieng  3486:             my $defbgone='';
                   3487:             my $defbgtwo='';
                   3488:             my $defbgthree = '';
1.57      albertel 3489: 
1.560     damieng  3490:             foreach my $rid (@ids) {
1.57      albertel 3491: 
                   3492:                 my ($inmapid)=($rid=~/\.(\d+)$/);
1.446     bisitz   3493:                 if ((!$pssymb &&
1.560     damieng  3494:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3495:                         ||
                   3496:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3497: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3498:                     if ($defbgone eq '#E0E099') {
                   3499:                         $defbgone='#E0E0DD';
1.57      albertel 3500:                     } else {
1.419     bisitz   3501:                         $defbgone='#E0E099';
1.57      albertel 3502:                     }
1.419     bisitz   3503:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3504:                         $defbgtwo='#FFFFDD';
1.57      albertel 3505:                     } else {
1.473     amueller 3506:                         $defbgtwo='#FFFF99';
1.57      albertel 3507:                     }
1.419     bisitz   3508:                     if ($defbgthree eq '#FFBB99') {
                   3509:                         $defbgthree='#FFBBDD';
1.269     raeburn  3510:                     } else {
1.419     bisitz   3511:                         $defbgthree='#FFBB99';
1.269     raeburn  3512:                     }
                   3513: 
1.57      albertel 3514:                     my $thistitle='';
                   3515:                     my %name=   ();
                   3516:                     undef %name;
                   3517:                     my %part=   ();
                   3518:                     my %display=();
                   3519:                     my %type=   ();
                   3520:                     my %default=();
1.196     www      3521:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3522:                     my $toolsymb;
                   3523:                     if ($uri =~ /ext\.tool$/) {
                   3524:                         $toolsymb = $symbp{$rid};
                   3525:                     }
1.57      albertel 3526: 
1.506     www      3527:                     my $filter=$env{'form.filter'};
1.548     raeburn  3528:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3529:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.584     raeburn  3530:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name',$toolsymb);
1.560     damieng  3531:     # We may only want certain parameters listed
                   3532:                             if ($filter) {
                   3533:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3534:                             }
                   3535:                             $name{$tempkeyp}=$parmname;
1.584     raeburn  3536:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part',$toolsymb);
1.560     damieng  3537: 
1.584     raeburn  3538:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display',$toolsymb);
1.560     damieng  3539:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3540:                                 my $identifier;
                   3541:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3542:                                     $identifier = $1;
                   3543:                                 }
                   3544:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3545:                             } else {
                   3546:                                 $display{$tempkeyp} = $parmdis;
                   3547:                             }
                   3548:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3549:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.584     raeburn  3550:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp,$toolsymb);
                   3551:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type',$toolsymb);
                   3552:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title',$toolsymb);
1.57      albertel 3553:                         }
                   3554:                     }
1.548     raeburn  3555:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3556:                     if ($totalparms>0) {
1.560     damieng  3557:                         my $firstrow=1;
1.473     amueller 3558:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.582     raeburn  3559:                         my $navmap = Apache::lonnavmaps::navmap->new();
                   3560:                         my @recurseup;
                   3561:                         if (ref($navmap) && $mapp{$rid}) {
                   3562:                             @recurseup = $navmap->recurseup_maps($mapp{$rid});
                   3563:                         }
1.419     bisitz   3564:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3565:                              ' rowspan='.$totalparms.
1.419     bisitz   3566:                              '><tt><font size="-1">'.
1.57      albertel 3567:                              join(' / ',split(/\//,$uri)).
                   3568:                              '</font></tt><p><b>'.
1.154     albertel 3569:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3570:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3571:                           &escape($symbp{$rid}).
1.336     albertel 3572:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3573:                              " target=\"_self\">$title");
1.57      albertel 3574: 
                   3575:                         if ($thistitle) {
1.473     amueller 3576:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3577:                         }
                   3578:                         $r->print('</a></b></td>');
1.419     bisitz   3579:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3580:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3581:                                       '</td>');
                   3582: 
1.419     bisitz   3583:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3584:                                       ' rowspan='.$totalparms.
1.238     www      3585:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3586:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3587:                             unless ($firstrow) {
                   3588:                                 $r->print('<tr>');
                   3589:                             } else {
                   3590:                                 undef $firstrow;
                   3591:                             }
1.548     raeburn  3592:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3593:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3594:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.582     raeburn  3595:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly,
                   3596:                                        \@recurseup,\%maptitles,\%allmaps_inverted,
                   3597:                                        \$numreclinks);
1.57      albertel 3598:                         }
                   3599:                     }
                   3600:                 }
                   3601:             } # end foreach ids
1.43      albertel 3602: # -------------------------------------------------- End entry for one resource
1.517     www      3603:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3604:         } # end of  full
1.57      albertel 3605: #--------------------------------------------------- Entry for parm level map
                   3606:         if ($parmlev eq 'map') {
1.419     bisitz   3607:             my $defbgone = '#E0E099';
                   3608:             my $defbgtwo = '#FFFF99';
                   3609:             my $defbgthree = '#FFBB99';
1.57      albertel 3610: 
                   3611:             my %maplist;
                   3612: 
                   3613:             if ($pschp eq 'all') {
1.446     bisitz   3614:                 %maplist = %allmaps;
1.57      albertel 3615:             } else {
                   3616:                 %maplist = ($pschp => $mapp{$pschp});
                   3617:             }
                   3618: 
                   3619: #-------------------------------------------- for each map, gather information
                   3620:             my $mapid;
1.560     damieng  3621:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3622:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3623: 
                   3624: #-----------------------  loop through ids and get all parameter types for map
                   3625: #-----------------------------------------          and associated information
                   3626:                 my %name = ();
                   3627:                 my %part = ();
                   3628:                 my %display = ();
                   3629:                 my %type = ();
                   3630:                 my %default = ();
                   3631:                 my $map = 0;
                   3632: 
1.473     amueller 3633: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3634: 
1.548     raeburn  3635:                 foreach my $id (@ids) {
                   3636:                     ($map)=($id =~ /([\d]*?)\./);
                   3637:                     my $rid = $id;
1.446     bisitz   3638: 
1.57      albertel 3639: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3640: 
1.560     damieng  3641:                     if ($map eq $mapid) {
1.473     amueller 3642:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3643:                         my $toolsymb;
                   3644:                         if ($uri =~ /ext\.tool$/) {
                   3645:                             $toolsymb = $symbp{$rid};
                   3646:                         }
1.582     raeburn  3647: 
1.57      albertel 3648: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3649: 
                   3650: #--------------------------------------------------------------------
                   3651: # @catmarker contains list of all possible parameters including part #s
                   3652: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3653: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3654: # When storing information, store as part 0
                   3655: # When requesting information, request from full part
                   3656: #-------------------------------------------------------------------
1.548     raeburn  3657:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3658:                             my $tempkeyp = $fullkeyp;
                   3659:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3660: 
1.548     raeburn  3661:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3662:                                 $part{$tempkeyp}="0";
1.584     raeburn  3663:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3664:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3665:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3666:                                     my $identifier;
                   3667:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3668:                                         $identifier = $1;
                   3669:                                     }
                   3670:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3671:                                 } else {
                   3672:                                     $display{$tempkeyp} = $parmdis;
                   3673:                                 }
                   3674:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3675:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3676:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3677:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3678:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.473     amueller 3679:                               }
                   3680:                         } # end loop through keys
1.560     damieng  3681:                     }
1.57      albertel 3682:                 } # end loop through ids
1.446     bisitz   3683: 
1.57      albertel 3684: #---------------------------------------------------- print header information
1.133     www      3685:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3686:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3687:                 my $tmp="";
1.57      albertel 3688:                 if ($uname) {
1.473     amueller 3689:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3690:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3691:                         &mt('in')." \n";
1.57      albertel 3692:                 } else {
1.401     bisitz   3693:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3694:                 }
1.269     raeburn  3695:                 if ($cgroup) {
1.401     bisitz   3696:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3697:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3698:                     $csec = '';
                   3699:                 } elsif ($csec) {
1.401     bisitz   3700:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3701:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3702:                 }
1.401     bisitz   3703:                 $r->print('<div align="center"><h4>'
                   3704:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3705:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3706:                              ,$tmp
                   3707:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3708:                              )
                   3709:                          ."<br /></h4>\n"
1.422     bisitz   3710:                 );
1.57      albertel 3711: #---------------------------------------------------------------- print table
1.419     bisitz   3712:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3713:                          .&Apache::loncommon::start_data_table_header_row()
                   3714:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3715:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3716:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3717:                          .&Apache::loncommon::end_data_table_header_row()
                   3718:                 );
1.57      albertel 3719: 
1.582     raeburn  3720:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   3721:                 my @recurseup;
                   3722:                 if (ref($navmap)) {
                   3723:                      my $mapres = $navmap->getByMapPc($mapid);
                   3724:                      if (ref($mapres)) {
                   3725:                          @recurseup = $navmap->recurseup_maps($mapres->src());
                   3726:                      }
                   3727:                 }
                   3728: 
                   3729: 
1.548     raeburn  3730:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3731:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3732:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3733:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3734:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
1.582     raeburn  3735:                            $readonly,\@recurseup,\%maptitles,\%allmaps_inverted,
                   3736:                            \$numreclinks);
1.57      albertel 3737:                 }
1.422     bisitz   3738:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3739:                          .'</div>'
                   3740:                 );
1.57      albertel 3741:             } # end each map
                   3742:         } # end of $parmlev eq map
                   3743: #--------------------------------- Entry for parm level general (Course level)
                   3744:         if ($parmlev eq 'general') {
1.473     amueller 3745:             my $defbgone = '#E0E099';
1.419     bisitz   3746:             my $defbgtwo = '#FFFF99';
                   3747:             my $defbgthree = '#FFBB99';
1.57      albertel 3748: 
                   3749: #-------------------------------------------- for each map, gather information
                   3750:             my $mapid="0.0";
                   3751: #-----------------------  loop through ids and get all parameter types for map
                   3752: #-----------------------------------------          and associated information
                   3753:             my %name = ();
                   3754:             my %part = ();
                   3755:             my %display = ();
                   3756:             my %type = ();
                   3757:             my %default = ();
1.446     bisitz   3758: 
1.548     raeburn  3759:             foreach $id (@ids) {
                   3760:                 my $rid = $id;
1.446     bisitz   3761: 
1.196     www      3762:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.584     raeburn  3763:                 my $toolsymb;
                   3764:                 if ($uri =~ /ext\.tool$/) {
                   3765:                     $toolsymb = $symbp{$rid};
                   3766:                 }
1.57      albertel 3767: 
                   3768: #--------------------------------------------------------------------
                   3769: # @catmarker contains list of all possible parameters including part #s
                   3770: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3771: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3772: # When storing information, store as part 0
                   3773: # When requesting information, request from full part
                   3774: #-------------------------------------------------------------------
1.548     raeburn  3775:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3776:                     my $tempkeyp = $fullkeyp;
                   3777:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3778:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3779:                         $part{$tempkeyp}="0";
1.584     raeburn  3780:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name',$toolsymb);
                   3781:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display',$toolsymb);
1.473     amueller 3782:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3783:                             my $identifier;
                   3784:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3785:                                 $identifier = $1;
                   3786:                             }
                   3787:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3788:                         } else {
                   3789:                             $display{$tempkeyp} = $parmdis;
                   3790:                         }
                   3791:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3792:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3793:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.584     raeburn  3794:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp,$toolsymb);
                   3795:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type',$toolsymb);
1.560     damieng  3796:                     }
1.57      albertel 3797:                 } # end loop through keys
                   3798:             } # end loop through ids
1.446     bisitz   3799: 
1.57      albertel 3800: #---------------------------------------------------- print header information
1.473     amueller 3801:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3802:             $r->print(<<ENDMAPONE);
1.419     bisitz   3803: <center>
                   3804: <h4>$setdef
1.135     albertel 3805: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3806: ENDMAPONE
                   3807:             if ($uname) {
1.473     amueller 3808:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3809:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3810:             } else {
1.135     albertel 3811:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3812:             }
1.446     bisitz   3813: 
1.135     albertel 3814:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3815:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3816:             $r->print("</h4>\n");
1.57      albertel 3817: #---------------------------------------------------------------- print table
1.419     bisitz   3818:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3819:                      .&Apache::loncommon::start_data_table_header_row()
                   3820:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3821:                      .'<th>'.&mt('Default Value').'</th>'
                   3822:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3823:                      .&Apache::loncommon::end_data_table_header_row()
                   3824:             );
1.57      albertel 3825: 
1.548     raeburn  3826:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3827:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3828:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3829:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3830:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3831:                            $readonly);
1.57      albertel 3832:             }
1.419     bisitz   3833:             $r->print(&Apache::loncommon::end_data_table()
                   3834:                      .'</p>'
                   3835:                      .'</center>'
                   3836:             );
1.57      albertel 3837:         } # end of $parmlev eq general
1.43      albertel 3838:     }
1.507     www      3839:     $r->print('</form>');
1.582     raeburn  3840:     if ($numreclinks) {
                   3841:         $r->print(<<"END");
                   3842: <form name="recurseform" action="/adm/parmset?action=settable" method="post">
                   3843: <input type="hidden" name="pschp" />
                   3844: <input type="hidden" name="pscat" />
                   3845: <input type="hidden" name="psprt" />
                   3846: <input type="hidden" name="hideparmsel" value="hidden" />
                   3847: </form>
                   3848: <script type="text/javascript">
                   3849: function pjumprec(rid,name,part) {
                   3850:     document.forms.recurseform.pschp.value = rid;
                   3851:     document.forms.recurseform.pscat.value = name;
                   3852:     document.forms.recurseform.psprt.value = part;
                   3853:     document.forms.recurseform.submit();
                   3854:     return false;
                   3855: }
                   3856: </script>
                   3857: END
                   3858:     }
1.507     www      3859:     &endSettingsScreen($r);
                   3860:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3861: } # end sub assessparms
1.30      www      3862: 
1.560     damieng  3863: 
                   3864: 
1.120     www      3865: ##################################################
1.560     damieng  3866: # OVERVIEW MODE
1.207     www      3867: ##################################################
1.124     www      3868: 
1.563     damieng  3869: my $tableopen; # boolean, true if HTML table is already opened
                   3870: 
                   3871: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3872: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3873: # @returns {string}
1.124     www      3874: sub tablestart {
1.576     raeburn  3875:     my ($readonly,$is_map) = @_;
1.124     www      3876:     if ($tableopen) {
1.552     raeburn  3877:         return '';
1.124     www      3878:     } else {
1.552     raeburn  3879:         $tableopen=1;
                   3880:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3881:         if ($readonly) {
                   3882:             $output .= '<th>'.&mt('Current value').'</th>';
                   3883:         } else {
1.576     raeburn  3884:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3885:                        '<th>'.&mt('Set to ...').'</th>';
                   3886:             if ($is_map) {
                   3887:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3888:             }
1.552     raeburn  3889:         }
                   3890:         $output .= '</tr>';
                   3891:         return $output;
1.124     www      3892:     }
                   3893: }
                   3894: 
1.563     damieng  3895: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3896: # @returns {string}
1.124     www      3897: sub tableend {
                   3898:     if ($tableopen) {
1.560     damieng  3899:         $tableopen=0;
                   3900:         return &Apache::loncommon::end_data_table();
1.124     www      3901:     } else {
1.560     damieng  3902:         return'';
1.124     www      3903:     }
                   3904: }
                   3905: 
1.563     damieng  3906: # Reads course and user information.
                   3907: # 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).
                   3908: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3909: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3910: # @param {string} $crs - course number
                   3911: # @param {string} $dom - course domain
                   3912: # @returns {hash reference|Array}
1.207     www      3913: sub readdata {
                   3914:     my ($crs,$dom)=@_;
                   3915: # Read coursedata
                   3916:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3917: # Read userdata
                   3918: 
                   3919:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3920:     foreach my $user (keys(%$classlist)) {
                   3921:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3922:             my ($tuname,$tudom)=($1,$2);
                   3923:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3924:             foreach my $userkey (keys(%{$useropt})) {
                   3925:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3926:                     my $newkey=$userkey;
1.548     raeburn  3927:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3928:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3929:                 }
                   3930:             }
1.473     amueller 3931:         }
                   3932:     }
1.552     raeburn  3933:     if (wantarray) {
                   3934:         return ($resourcedata,$classlist);
                   3935:     } else {
                   3936:         return $resourcedata;
                   3937:     }
1.207     www      3938: }
                   3939: 
                   3940: 
1.563     damieng  3941: # Stores parameter data, using form parameters directly.
                   3942: #
                   3943: # 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  3944: # set_* (except settext, setipallow, setipdeny, setdeeplink) - set a parameter value
1.563     damieng  3945: # del_* - remove a parameter
                   3946: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3947: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3948: # key_* - date values
                   3949: # days_* - for date intervals
                   3950: # hours_* - for date intervals
                   3951: # minutes_* - for date intervals
                   3952: # seconds_* - for date intervals
                   3953: # done_* - for date intervals
                   3954: # typeof_* - parameter type
                   3955: # 
                   3956: # @param {Apache2::RequestRec} $r - the Apache request
                   3957: # @param {string} $crs - course number
                   3958: # @param {string} $dom - course domain
1.208     www      3959: sub storedata {
                   3960:     my ($r,$crs,$dom)=@_;
1.207     www      3961: # Set userlevel immediately
                   3962: # Do an intermediate store of course level
                   3963:     my $olddata=&readdata($crs,$dom);
1.124     www      3964:     my %newdata=();
                   3965:     undef %newdata;
                   3966:     my @deldata=();
1.576     raeburn  3967:     my @delrec=();
                   3968:     my @delnonrec=();
1.124     www      3969:     undef @deldata;
1.504     raeburn  3970:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3971:     my $now = time;
1.560     damieng  3972:     foreach my $key (keys(%env)) {
                   3973:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3974:             my $cmd=$1;
                   3975:             my $thiskey=$2;
1.576     raeburn  3976:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
1.588     raeburn  3977:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny' || $cmd eq 'setdeeplink');
1.576     raeburn  3978:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3979:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3980:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3981:                     $altkey = $thiskey;
                   3982:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   3983:                     if ($env{'form.rec_'.$thiskey}) {
                   3984:                         $recursive = 1;
                   3985:                     }
                   3986:                 }
                   3987:             }
1.560     damieng  3988:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 3989:             if ($tuname) {
1.576     raeburn  3990:                 $tkey=$thiskey;
1.560     damieng  3991:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  3992:                 if ($altkey) {
                   3993:                     $tkeynonrec = $tkey; 
                   3994:                     $tkeyrec = $altkey;
                   3995:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   3996:                 }
1.560     damieng  3997:             }
                   3998:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  3999:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   4000:                 if ($cmd eq 'set') {
                   4001:                     $data=$env{$key};
                   4002:                     $valmatch = '';
                   4003:                     $valchk = $data;
                   4004:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4005:                     $text = &mt('Saved modified parameter for');
                   4006:                     if ($typeof eq 'string_questiontype') {
                   4007:                         $name = 'type';
1.588     raeburn  4008:                     } elsif (($typeof eq 'string_lenient') || ($typeof eq 'string_deeplink')) {
                   4009:                         ($name) = ($typeof =~ /^string_(lenient|deeplink)$/);
1.563     damieng  4010:                         my $stringmatch = &standard_string_matches($typeof);
                   4011:                         if (ref($stringmatch) eq 'ARRAY') {
                   4012:                             foreach my $item (@{$stringmatch}) {
                   4013:                                 if (ref($item) eq 'ARRAY') {
                   4014:                                     my ($regexpname,$pattern) = @{$item};
                   4015:                                     if ($pattern ne '') {
                   4016:                                         if ($data =~ /$pattern/) {
                   4017:                                             $valmatch = $regexpname;
                   4018:                                             $valchk = '';
                   4019:                                             last;
                   4020:                                         }
1.560     damieng  4021:                                     }
1.549     raeburn  4022:                                 }
                   4023:                             }
                   4024:                         }
1.563     damieng  4025:                     } elsif ($typeof eq 'string_discussvote') {
                   4026:                         $name = 'discussvote';
                   4027:                     } elsif ($typeof eq 'string_examcode') {
                   4028:                         $name = 'examcode';
                   4029:                         if (&Apache::lonnet::validCODE($data)) {
                   4030:                             $valchk = 'valid';
                   4031:                         }
                   4032:                     } elsif ($typeof eq 'string_yesno') {
                   4033:                         if ($thiskey =~ /\.retrypartial$/) {
                   4034:                             $name = 'retrypartial';
                   4035:                         }
1.549     raeburn  4036:                     }
1.563     damieng  4037:                 } elsif ($cmd eq 'datepointer') {
                   4038:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   4039:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4040:                     $text = &mt('Saved modified date for');
                   4041:                     if ($typeof eq 'date_start') {
                   4042:                         if ($thiskey =~ /\.printstartdate$/) {
                   4043:                             $name = 'printstartdate';
                   4044:                             if (($data) && ($data > $now)) {
                   4045:                                 $valchk = 'future';
                   4046:                             }
1.560     damieng  4047:                         }
1.563     damieng  4048:                     } elsif ($typeof eq 'date_end') {
                   4049:                         if ($thiskey =~ /\.printenddate$/) {
                   4050:                             $name = 'printenddate';
                   4051:                             if (($data) && ($data < $now)) {
                   4052:                                 $valchk = 'past';
                   4053:                             }
1.560     damieng  4054:                         }
1.504     raeburn  4055:                     }
1.563     damieng  4056:                 } elsif ($cmd eq 'dateinterval') {
                   4057:                     $data=&get_date_interval_from_form($thiskey);
                   4058:                     if ($thiskey =~ /\.interval$/) {
                   4059:                         $name = 'interval';
                   4060:                         my $intervaltype = &get_intervaltype($name);
                   4061:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   4062:                         if (ref($intervalmatch) eq 'ARRAY') {
                   4063:                             foreach my $item (@{$intervalmatch}) {
                   4064:                                 if (ref($item) eq 'ARRAY') {
                   4065:                                     my ($regexpname,$pattern) = @{$item};
                   4066:                                     if ($pattern ne '') {
                   4067:                                         if ($data =~ /$pattern/) {
                   4068:                                             $valmatch = $regexpname;
                   4069:                                             $valchk = '';
                   4070:                                             last;
                   4071:                                         }
1.560     damieng  4072:                                     }
1.554     raeburn  4073:                                 }
                   4074:                             }
                   4075:                         }
                   4076:                     }
1.563     damieng  4077:                     $typeof=$env{'form.typeof_'.$thiskey};
                   4078:                     $text = &mt('Saved modified date for');
1.554     raeburn  4079:                 }
1.576     raeburn  4080:                 if ($recursive) {
1.563     damieng  4081:                     $namematch = 'maplevelrecurse';
1.560     damieng  4082:                 }
1.563     damieng  4083:                 if (($name ne '') || ($namematch ne '')) {
                   4084:                     my ($needsrelease,$needsnewer);
                   4085:                     if ($name ne '') {
                   4086:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  4087:                         if ($needsrelease) {
                   4088:                             unless ($got_chostname) {
1.563     damieng  4089:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  4090:                                 $got_chostname = 1;
                   4091:                             }
1.563     damieng  4092:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   4093:                                                                 $needsrelease,
                   4094:                                                                 $cmajor,$cminor);
                   4095:                         }
                   4096:                     }
                   4097:                     if ($namematch ne '') {
                   4098:                         if ($needsnewer) {
                   4099:                             undef($namematch);
1.560     damieng  4100:                         } else {
1.563     damieng  4101:                             my $currneeded;
                   4102:                             if ($needsrelease) {
                   4103:                                 $currneeded = $needsrelease;
                   4104:                             }
                   4105:                             $needsrelease =
                   4106:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   4107:                             if (($needsrelease) &&
                   4108:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   4109:                                 unless ($got_chostname) {
                   4110:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   4111:                                     $got_chostname = 1;
                   4112:                                 }
                   4113:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   4114:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   4115:                             } else {
                   4116:                                 undef($namematch);
                   4117:                             }
1.560     damieng  4118:                         }
1.557     raeburn  4119:                     }
1.563     damieng  4120:                     if ($needsnewer) {
                   4121:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   4122:                                                             $chostname,$cmajor,
                   4123:                                                             $cminor,$needsrelease));
                   4124:                         next;
                   4125:                     }
1.504     raeburn  4126:                 }
1.576     raeburn  4127:                 my ($reconlychg,$haschange,$storekey);
                   4128:                 if ($tuname) {
                   4129:                     my $ustorekey;
                   4130:                     if ($altkey) {
                   4131:                         if ($recursive) {
                   4132:                             if (exists($$olddata{$thiskey})) {
                   4133:                                 if ($$olddata{$thiskey} eq $data) {
                   4134:                                     $reconlychg = 1;
                   4135:                                 }
                   4136:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   4137:                             }
                   4138:                             if (exists($$olddata{$altkey})) {
                   4139:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4140:                                     $haschange = 1;
                   4141:                                 }
                   4142:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4143:                                 $haschange = 1;
                   4144:                             }
                   4145:                             $ustorekey = $tkeyrec;
                   4146:                         } else {
                   4147:                             if (exists($$olddata{$altkey})) {
                   4148:                                 if ($$olddata{$altkey} eq $data) {
                   4149:                                     $reconlychg = 1;
                   4150:                                 }
                   4151:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   4152:                             }
                   4153:                             if (exists($$olddata{$thiskey})) {
                   4154:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4155:                                     $haschange = 1;
                   4156:                                 }
                   4157:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4158:                                 $haschange = 1;
                   4159:                             }
                   4160:                             $ustorekey = $tkeynonrec;
                   4161:                         }
                   4162:                     } else {
                   4163:                         if (exists($$olddata{$tkey})) {
                   4164:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   4165:                                 $haschange = 1;
                   4166:                             }
                   4167:                             $ustorekey = $tkey;
                   4168:                         }
                   4169:                     }
                   4170:                     if ($haschange || $reconlychg)  {
                   4171:                         unless ($env{'form.del_'.$thiskey}) {
                   4172:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   4173:                                                                      $ustorekey.'.type' => $typeof},
                   4174:                                                                      $tudom,$tuname) eq 'ok') {
                   4175:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   4176:                                 $r->print('<br />'.$text.' '.
                   4177:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   4178:                             } else {
                   4179:                                 $r->print('<div class="LC_error">'.
                   4180:                                           &mt('Error saving parameters').'</div>');
                   4181:                             }
                   4182:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4183:                         }
                   4184:                     }
                   4185:                 } else {
                   4186:                     if ($altkey) {
                   4187:                         if ($recursive) {
                   4188:                             if (exists($$olddata{$thiskey})) {
                   4189:                                 if ($$olddata{$thiskey} eq $data) {
                   4190:                                     $reconlychg = 1;
                   4191:                                 }
                   4192:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   4193:                             }
                   4194:                             if (exists($$olddata{$altkey})) {
                   4195:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4196:                                     $haschange = 1;
                   4197:                                 }
                   4198:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4199:                                 $haschange = 1;
                   4200:                             }
                   4201:                             $storekey = $altkey;
1.563     damieng  4202:                         } else {
1.576     raeburn  4203:                             if (exists($$olddata{$altkey})) {
                   4204:                                 if ($$olddata{$altkey} eq $data) {
                   4205:                                     $reconlychg = 1;
                   4206:                                 }
                   4207:                                 push(@delrec,($altkey,$altkey.'.type'));
                   4208:                             } 
                   4209:                             if (exists($$olddata{$thiskey})) {
                   4210:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4211:                                     $haschange = 1;
                   4212:                                 }
                   4213:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4214:                                 $haschange = 1;
                   4215:                             }
                   4216:                             $storekey = $thiskey;
1.563     damieng  4217:                         }
1.560     damieng  4218:                     } else {
1.576     raeburn  4219:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4220:                             $haschange = 1;
                   4221:                             $storekey = $thiskey;
                   4222:                         }
                   4223:                     }
                   4224:                 }
                   4225:                 if ($reconlychg || $haschange) {
                   4226:                     unless ($env{'form.del_'.$thiskey}) {
                   4227:                         $newdata{$storekey}=$data;
                   4228:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  4229:                     }
                   4230:                 }
                   4231:             } elsif ($cmd eq 'del') {
                   4232:                 if ($tuname) {
1.576     raeburn  4233:                     my $error;
                   4234:                     if ($altkey) {  
                   4235:                         if (exists($$olddata{$altkey})) {
                   4236:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4237:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   4238:                                 if ($recursive) {
                   4239:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4240:                                 }
                   4241:                             } elsif ($recursive) {
                   4242:                                 $error = 1;
                   4243:                             }
                   4244:                         }
                   4245:                         if (exists($$olddata{$thiskey})) {
                   4246:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4247:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   4248:                                 unless ($recursive) {
                   4249:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4250:                                 }
                   4251:                             } elsif (!$recursive) {
                   4252:                                 $error = 1;
                   4253:                             }
                   4254:                         }
1.560     damieng  4255:                     } else {
1.576     raeburn  4256:                         if (exists($$olddata{$thiskey})) {
                   4257:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   4258:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   4259:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4260:                             } else {
                   4261:                                 $error = 1;
                   4262:                             }
                   4263:                         }
                   4264:                     }
                   4265:                     if ($error) { 
1.560     damieng  4266:                         $r->print('<div class="LC_error">'.
                   4267:                             &mt('Error deleting parameters').'</div>');
                   4268:                     }
                   4269:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4270:                 } else {
1.576     raeburn  4271:                     if ($altkey) {
                   4272:                         if (exists($$olddata{$altkey})) {
                   4273:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   4274:                                 push(@deldata,($altkey,$altkey.'.type'));
                   4275:                             }
                   4276:                         }
                   4277:                         if (exists($$olddata{$thiskey})) {
                   4278:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   4279:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   4280:                             }
                   4281:                         }
                   4282:                     } elsif (exists($$olddata{$thiskey})) {
                   4283:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   4284:                     }
1.560     damieng  4285:                 }
1.473     amueller 4286:             }
                   4287:         }
                   4288:     }
1.207     www      4289: # Store all course level
1.144     www      4290:     my $delentries=$#deldata+1;
1.576     raeburn  4291:     my @alldels;
                   4292:     if (@delrec) {
                   4293:         push(@alldels,@delrec);
                   4294:     }
                   4295:     if (@delnonrec) {
                   4296:         push(@alldels,@delnonrec);
                   4297:     }
                   4298:     if (@deldata) {
                   4299:         push(@alldels,@deldata);
                   4300:     }
1.548     raeburn  4301:     my @newdatakeys=keys(%newdata);
1.144     www      4302:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4303:     my ($delresult,$devalidate);
                   4304:     if (@alldels) {
                   4305:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4306:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4307:             &log_parmset(\%loghash,1);
1.576     raeburn  4308:             if ($delentries) {
                   4309:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4310:             }
                   4311:         } elsif ($delentries) {
1.560     damieng  4312:             $r->print('<div class="LC_error">'.
                   4313:                 &mt('Error deleting parameters').'</div>');
                   4314:         }
1.576     raeburn  4315:         $devalidate = 1; 
1.144     www      4316:     }
                   4317:     if ($putentries) {
1.560     damieng  4318:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4319:                     &log_parmset(\%newdata,0);
                   4320:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4321:         } else {
                   4322:             $r->print('<div class="LC_error">'.
                   4323:                 &mt('Error saving parameters').'</div>');
                   4324:         }
1.576     raeburn  4325:         $devalidate = 1; 
                   4326:     }
                   4327:     if ($devalidate) {
1.560     damieng  4328:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4329:     }
1.208     www      4330: }
1.207     www      4331: 
1.563     damieng  4332: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4333: #
                   4334: # @param {string} $key - the key
                   4335: # @returns {Array}
1.208     www      4336: sub extractuser {
                   4337:     my $key=shift;
1.350     albertel 4338:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4339: }
1.206     www      4340: 
1.563     damieng  4341: # Parses a parameter key and returns the components.
                   4342: #
                   4343: # @param {string} $key - 
                   4344: # @param {hash reference} $listdata - 
                   4345: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4346: sub parse_listdata_key {
                   4347:     my ($key,$listdata) = @_;
                   4348:     # split into student/section affected, and
                   4349:     # the realm (folder/resource part and parameter
1.446     bisitz   4350:     my ($student,$realm) =
1.473     amueller 4351:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4352:     # if course wide student would be undefined
                   4353:     if (!defined($student)) {
1.560     damieng  4354:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4355:     }
                   4356:     # strip off the .type if it's not the Question type parameter
                   4357:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4358:         $realm=~s/\.type//;
1.381     albertel 4359:     }
                   4360:     # split into resource+part and parameter name
1.388     albertel 4361:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4362:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4363:     return ($student,$res,$part,$parm);
                   4364: }
                   4365: 
1.563     damieng  4366: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4367: #
                   4368: # @param {Apache2::RequestRec} $r - the Apache request
                   4369: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4370: # @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
                   4371: # @param {string} $sortorder - realmstudent|studentrealm
                   4372: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4373: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4374: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4375: # @returns{integer} - number of $listdata parameters processed
1.208     www      4376: sub listdata {
1.568     raeburn  4377:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4378:     
1.207     www      4379: # Start list output
1.206     www      4380: 
1.122     www      4381:     my $oldsection='';
                   4382:     my $oldrealm='';
                   4383:     my $oldpart='';
1.123     www      4384:     my $pointer=0;
1.124     www      4385:     $tableopen=0;
1.145     www      4386:     my $foundkeys=0;
1.248     albertel 4387:     my %keyorder=&standardkeyorder();
1.381     albertel 4388: 
1.552     raeburn  4389:     my ($secidx,%grouphash);
                   4390:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4391:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4392:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4393:             %grouphash = &Apache::longroup::coursegroups();
                   4394:         } elsif ($env{'request.course.groups'} ne '') {
1.585     raeburn  4395:             map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
1.553     raeburn  4396:         }
1.552     raeburn  4397:     }
                   4398: 
1.576     raeburn  4399:     foreach my $key (sort {
1.560     damieng  4400:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4401:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4402: 
1.560     damieng  4403:         # get the numerical order for the param
                   4404:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4405:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4406: 
1.560     damieng  4407:         my $result=0;
1.381     albertel 4408: 
1.560     damieng  4409:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4410:             if ($ares     ne $bres    ) {
1.560     damieng  4411:                 $result = ($ares     cmp $bres);
1.446     bisitz   4412:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4413:                 $result = ($astudent cmp $bstudent);
                   4414:             } elsif ($apart    ne $bpart   ) {
                   4415:                 $result = ($apart    cmp $bpart);
                   4416:             }
                   4417:         } else {
                   4418:             if      ($astudent ne $bstudent) {
                   4419:                 $result = ($astudent cmp $bstudent);
                   4420:             } elsif ($ares     ne $bres    ) {
                   4421:                 $result = ($ares     cmp $bres);
                   4422:             } elsif ($apart    ne $bpart   ) {
                   4423:                 $result = ($apart    cmp $bpart);
                   4424:             }
1.473     amueller 4425:         }
1.446     bisitz   4426: 
1.560     damieng  4427:         if (!$result) {
1.381     albertel 4428:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4429:                 $result = ($aparm <=> $bparm);
1.381     albertel 4430:             } elsif (defined($aparm)) {
1.560     damieng  4431:                 $result = -1;
1.381     albertel 4432:             } elsif (defined($bparm)) {
1.560     damieng  4433:                 $result = 1;
                   4434:             }
1.473     amueller 4435:         }
1.381     albertel 4436: 
1.560     damieng  4437:         $result;
                   4438:         
1.576     raeburn  4439:     } keys(%{$listdata})) { # foreach my $key
                   4440:         my $thiskey = $key;
1.560     damieng  4441:         if ($$listdata{$thiskey.'.type'}) {
                   4442:             my $thistype=$$listdata{$thiskey.'.type'};
                   4443:             if ($$resourcedata{$thiskey.'.type'}) {
                   4444:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4445:             }
                   4446:             my ($middle,$part,$name)=
1.572     damieng  4447:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4448:             my $section=&mt('All Students');
1.576     raeburn  4449:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4450:             if ($middle=~/^\[(.*)\]/) {
                   4451:                 my $issection=$1;
                   4452:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4453:                     my ($stuname,$studom) = ($1,$2);
                   4454:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4455:                         if (ref($classlist) eq 'HASH') {
                   4456:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4457:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4458:                             }
                   4459:                         }
                   4460:                     }
                   4461:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4462:                 } else {
                   4463:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4464:                         if (exists($grouphash{$issection})) {
                   4465:                             $section=&mt('Group').': '.$issection;
                   4466:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4467:                             $section = &mt('Section').': '.$issection;
                   4468:                         } else {
                   4469:                             next; 
1.552     raeburn  4470:                         }
1.560     damieng  4471:                     } else {
                   4472:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4473:                     }
                   4474:                 }
1.560     damieng  4475:                 $middle=~s/^\[(.*)\]//;
                   4476:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4477:                 $readonly = 1;
                   4478:             }
                   4479:             $middle=~s/\.+$//;
                   4480:             $middle=~s/^\.+//;
                   4481:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4482:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4483:             if ($caller eq 'overview') {
                   4484:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4485:                     $mapurl = $1;
                   4486:                     $maplevel = $2;
                   4487:                     $is_map = 1;
                   4488:                 }
                   4489:             } elsif ($caller eq 'newoverview') {
                   4490:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4491:                     $mapurl = $1;
                   4492:                     $maplevel = $2;
                   4493:                     $is_map = 1;
                   4494:                 }
                   4495:             }
                   4496:             if ($is_map) {
1.560     damieng  4497:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4498:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4499:                     if ($caller eq 'newoverview') {
                   4500:                         my $altkey = $thiskey;
                   4501:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4502:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4503:                             $is_recursive = 1;
                   4504:                             if ($$resourcedata{$altkey.'.type'}) {
                   4505:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4506:                             }
                   4507:                             $showval = $$resourcedata{$altkey};
                   4508:                         }
                   4509:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4510:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4511:                         $is_recursive = 1;
                   4512:                     }
1.560     damieng  4513:                 }
                   4514:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4515:             } elsif ($middle) {
                   4516:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4517:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4518:                     ': '.&Apache::lonnet::gettitle($middle).
                   4519:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4520:                     $id.')</span></span>';
                   4521:             }
                   4522:             if ($sortorder eq 'realmstudent') {
                   4523:                 if ($realm ne $oldrealm) {
                   4524:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4525:                     $oldrealm=$realm;
                   4526:                     $oldsection='';
                   4527:                 }
                   4528:                 if ($section ne $oldsection) {
                   4529:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4530:                     $oldsection=$section;
                   4531:                     $oldpart='';
                   4532:                 }
1.552     raeburn  4533:             } else {
1.560     damieng  4534:                 if ($section ne $oldsection) {
                   4535:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4536:                     $oldsection=$section;
                   4537:                     $oldrealm='';
                   4538:                 }
                   4539:                 if ($realm ne $oldrealm) {
                   4540:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4541:                     $oldrealm=$realm;
                   4542:                     $oldpart='';
1.552     raeburn  4543:                 }
                   4544:             }
1.560     damieng  4545:             if ($part ne $oldpart) {
                   4546:                 $r->print(&tableend().
                   4547:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4548:                 $oldpart=$part;
1.556     raeburn  4549:             }
1.560     damieng  4550:     #
                   4551:     # Ready to print
                   4552:     #
1.470     raeburn  4553:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4554:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4555:                 &Apache::loncommon::start_data_table_row().
                   4556:                 '<td><b>'.&mt($parmitem).
                   4557:                 '</b></td>');
                   4558:             unless ($readonly) {
                   4559:                 $r->print('<td><input type="checkbox" name="del_'.
                   4560:                         $thiskey.'" /></td>');
                   4561:             }
                   4562:             $r->print('<td>');
                   4563:             $foundkeys++;
                   4564:             if (&isdateparm($thistype)) {
                   4565:                 my $jskey='key_'.$pointer;
                   4566:                 my $state;
                   4567:                 $pointer++;
                   4568:                 if ($readonly) {
                   4569:                     $state = 'disabled';
                   4570:                 }
                   4571:                 $r->print(
                   4572:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4573:                                                         $jskey,
1.576     raeburn  4574:                                                         $showval,
1.560     damieng  4575:                                                         '',1,$state));
                   4576:                 unless  ($readonly) {
                   4577:                     $r->print(
                   4578:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4579:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4580:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4581:     &date_sanity_info($showval)
1.560     damieng  4582:                     );
                   4583:                 }
                   4584:             } elsif ($thistype eq 'date_interval') {
                   4585:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4586:                           $showval,$readonly));
1.560     damieng  4587:             } elsif ($thistype =~ m/^string/) {
                   4588:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4589:                           $showval,$name,$readonly));
1.560     damieng  4590:             } else {
1.576     raeburn  4591:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4592:             }
1.560     damieng  4593:             unless ($readonly) {
                   4594:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4595:                         $thistype.'" />');
1.552     raeburn  4596:             }
1.576     raeburn  4597:             $r->print('</td>');
                   4598:             if ($is_map) {
                   4599:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4600:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4601:                 } else {
                   4602:                     my ($disabled,$recon,$recoff);
                   4603:                     if ($readonly) {
                   4604:                         $disabled = ' disabled="disabled"';
                   4605:                     }
                   4606:                     if ($is_recursive) {
                   4607:                         $recon = ' checked="checked"';
                   4608:                     } else {
                   4609:                         $recoff = ' checked="checked"';
                   4610:                     }
                   4611:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4612:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4613:                 }
                   4614:             }
                   4615:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4616:         }
1.121     www      4617:     }
1.208     www      4618:     return $foundkeys;
                   4619: }
                   4620: 
1.563     damieng  4621: # Returns a string representing the interval, directly using form data matching the given key.
                   4622: # The returned string may also include information related to proctored exams.
                   4623: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4624: #
                   4625: # @param {string} $key - suffix for form fields related to the interval
                   4626: # @returns {string}
1.385     albertel 4627: sub get_date_interval_from_form {
                   4628:     my ($key) = @_;
                   4629:     my $seconds = 0;
                   4630:     foreach my $which (['days', 86400],
1.473     amueller 4631:                ['hours', 3600],
                   4632:                ['minutes', 60],
                   4633:                ['seconds',  1]) {
1.560     damieng  4634:         my ($name, $factor) = @{ $which };
                   4635:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4636:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4637:         }
1.473     amueller 4638:     }
1.560     damieng  4639:     if (($key =~ /\.interval$/) &&
                   4640:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4641:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4642:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4643:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4644:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4645:                 $seconds .= '_proctor';
                   4646:             }
                   4647:         } else {
                   4648:             $seconds .= $env{'form.done_'.$key}; 
                   4649:         }
                   4650:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4651:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4652:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4653:         }
1.554     raeburn  4654:     }
1.385     albertel 4655:     return $seconds;
                   4656: }
                   4657: 
                   4658: 
1.563     damieng  4659: # Returns HTML to enter a text value for a parameter.
                   4660: #
                   4661: # @param {string} $thiskey - parameter key
                   4662: # @param {string} $showval - the current value
                   4663: # @param {boolean} $readonly - true if the field should not be made editable
                   4664: # @returns {string}
1.383     albertel 4665: sub default_selector {
1.552     raeburn  4666:     my ($thiskey, $showval, $readonly) = @_;
                   4667:     my $disabled;
                   4668:     if ($readonly) {
                   4669:         $disabled = ' disabled="disabled"';
                   4670:     }
                   4671:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4672: }
                   4673: 
1.563     damieng  4674: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4675: #
                   4676: # @param {string} $thiskey - parameter key
                   4677: # @param {string} $showval - the current value
                   4678: # @param {boolean} $readonly - true if the fields should not be made editable
                   4679: # @returns {string}
1.549     raeburn  4680: sub string_ip_selector {
1.552     raeburn  4681:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4682:     my %access = (
                   4683:                    allow => [],
                   4684:                    deny  => [],
                   4685:                  );
                   4686:     if ($showval ne '') {
                   4687:         my @current;
                   4688:         if ($showval =~ /,/) {
                   4689:             @current = split(/,/,$showval);
                   4690:         } else {
                   4691:             @current = ($showval);
                   4692:         }
                   4693:         foreach my $item (@current) {
                   4694:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4695:                 push(@{$access{'deny'}},$1);
                   4696:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4697:                 push(@{$access{'allow'}},$item);
                   4698:             }
                   4699:         }
                   4700:     }
                   4701:     if (!@{$access{'allow'}}) {
                   4702:         @{$access{'allow'}} = ('');
                   4703:     }
                   4704:     if (!@{$access{'deny'}}) {
                   4705:         @{$access{'deny'}} = ('');
                   4706:     }
1.552     raeburn  4707:     my ($disabled,$addmore);
1.567     raeburn  4708:     if ($readonly) {
1.552     raeburn  4709:         $disabled=' disabled="disabled"';
                   4710:     } else {
                   4711:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4712:     }
1.549     raeburn  4713:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4714: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4715:     foreach my $acctype ('allow','deny') {
                   4716:         $output .= '
                   4717: <td valign="top">
                   4718: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4719:   <div class="LC_string_ipacc_inner">'."\n";
                   4720:         my $num = 0;
                   4721:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4722:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4723:             if ($num > 0) {
                   4724:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4725:             }
                   4726:             $output .= '</div>'."\n";
                   4727:             $num ++;
                   4728:         }
                   4729:         $output .= '
1.552     raeburn  4730:   </div>'.$addmore.'
1.549     raeburn  4731: </div>
                   4732: </td>';
                   4733:    }
                   4734:    $output .= '
                   4735: </tr>
                   4736: </table>'."\n";
                   4737:     return $output;
                   4738: }
                   4739: 
1.588     raeburn  4740: sub string_deeplink_selector {
                   4741:     my ($thiskey, $showval, $readonly) = @_;
                   4742:     my (@components,%values,@current,%titles,%options,%optiontext,%defaults,%posslti);
                   4743:     @components = ('listing','scope','urls');
                   4744:     %titles = &Apache::lonlocal::texthash (
                   4745:                   listing => 'In Contents and/or Gradebook',
                   4746:                   scope   => 'Access scope for link',
                   4747:                   urls    => 'Supported link types',
                   4748:               );
                   4749:     %options = (
                   4750:                    listing => ['full','absent','grades','details','datestatus'],
                   4751:                    scope   => ['res','map','rec'],
                   4752:                    urls    => ['any','only','key','lti'],
                   4753:                );
                   4754:     %optiontext = &Apache::lonlocal::texthash (
                   4755:                     full       => 'Listed (linked) in both',
                   4756:                     absent     => 'Not listed',
                   4757:                     grades     => 'Listed in grades only',
                   4758:                     details    => 'Listed (unlinked) in both',
                   4759:                     datestatus => 'Listed (unlinked) inc. status in both',
                   4760:                     res        => 'resource only',
                   4761:                     map        => 'enclosing map/folder',
                   4762:                     rec        => 'recursive map/folder',
                   4763:                     any        => 'regular + deep',
                   4764:                     only       => 'deep only',
                   4765:                     key        => 'deep with key',
                   4766:                     lti        => 'deep with LTI launch',
                   4767:                   );
                   4768:     if ($showval =~ /,/) {
                   4769:         @current = split(/,/,$showval);
                   4770:         ($values{'listing'}) = ($current[0] =~ /^(full|absent|grades|details|datestatus)$/);
                   4771:         ($values{'scope'}) = ($current[1] =~ /^(res|map|rec)$/);
                   4772:         ($values{'urls'}) = ($current[2] =~ /^(any|only|key:\w+|lti:\d+)$/);
                   4773:     } else {
                   4774:         $defaults{'listing'} = 'full';
                   4775:         $defaults{'scope'} = 'res';
                   4776:         $defaults{'urls'} = 'any';
                   4777:     }
                   4778:     my $disabled;
                   4779:     if ($readonly) {
                   4780:         $disabled=' disabled="disabled"';
                   4781:     }
                   4782:     my %lti = 
                   4783:         &Apache::lonnet::get_domain_lti($env{'course.'.$env{'request.course.id'}.'.domain'},
                   4784:                                         'provider');
                   4785:     foreach my $item (keys(%lti)) {
                   4786:         if (ref($lti{$item}) eq 'HASH') {
                   4787:             unless ($lti{$item}{'requser'}) {
                   4788:                 $posslti{$item} = $lti{$item}{'consumer'};
                   4789:             }
                   4790:         }
                   4791:     }
                   4792:     my $output = '<input type="hidden" name="set_'.$thiskey.'" /><table><tr>';
                   4793:     foreach my $item ('listing','scope','urls') {
                   4794:         $output .= '<th>'.$titles{$item}.'</th>';
                   4795:     }
                   4796:     $output .= '</tr><tr>';
                   4797:     foreach my $item (@components) {
                   4798:         $output .= '<td>';
                   4799:         if ($item eq 'urls') {
                   4800:             my $selected = $values{$item};
                   4801:             foreach my $option (@{$options{$item}}) {
                   4802:                 if ($option eq 'lti') {
                   4803:                     next unless (keys(%posslti));
                   4804:                 }
                   4805:                 my $checked;
                   4806:                 if ($selected =~ /^\Q$option\E/) {
                   4807:                     $checked = ' checked="checked"';
                   4808:                 }
                   4809:                 my $onclick;
                   4810:                 unless ($readonly) {
                   4811:                     my $esc_key = &js_escape($thiskey);
                   4812:                     $onclick = ' onclick="toggleDeepLink(this.form,'."'$item','$esc_key'".');"';
                   4813:                 }
                   4814:                 $output .= '<span class="LC_nobreak"><label>'.
                   4815:                            '<input type="radio" name="deeplink_'.$item.'_'.$thiskey.'" value="'.$option.'"'.$onclick.$disabled.$checked.' />'."\n".
                   4816:                            $optiontext{$option}.'</label>';
                   4817:                 if ($option eq 'key') {
                   4818:                     my $visibility="hidden";
                   4819:                     my $currkey;
                   4820:                     if ($checked) {
                   4821:                         $visibility = "text";
                   4822:                         $currkey = (split(/\:/,$values{$item}))[1];
                   4823:                     }
                   4824:                     $output .= '&nbsp;'.
                   4825:                         '<input type="'.$visibility.'" name="deeplink_'.$option.'_'.$thiskey.'" id="deeplink_'.$option.'_'.$item.'_'.$thiskey.'" value="'.$currkey.'" size="6"'.$disabled.' />';
                   4826:                 } elsif ($option eq 'lti') {
                   4827:                     my $display="none";
                   4828:                     my ($currlti,$blankcheck);
                   4829:                     if ($checked) {
                   4830:                         $display = 'inline-block';
                   4831:                         $currlti = (split(/\:/,$values{$item}))[1];
                   4832:                     } else {
                   4833:                         $blankcheck = ' selected="selected"';
                   4834:                     }
                   4835:                     $output .= '<div id="deeplinkdiv_'.$option.'_'.$item.'_'.$thiskey.'"'.
                   4836:                                ' style="display: '.$display.'">&nbsp;<select name="'.
                   4837:                                'deeplink_'.$option.'_'.$thiskey.'"'.$disabled.'>'.
                   4838:                                '<option value=""'.$blankcheck.'>'.&mt('Select Provider').'</option>'."\n";
                   4839:                     foreach my $lti (sort { $a <=> $b } keys(%posslti)) {
                   4840:                         my $selected;
                   4841:                         if ($lti == $currlti) {
                   4842:                             $selected = ' selected="selected"';
                   4843:                         }
                   4844:                         $output .= '<option value="'.$lti.'"'.$selected.'>'.$posslti{$lti}.'</option>';
                   4845:                     }
                   4846:                     $output .= '</select></div>';
                   4847:                 }
                   4848:                 $output .= '</span> ';
                   4849:             }
                   4850:         } else {
                   4851:             my $selected = $values{$item};
                   4852:             my $defsel;
                   4853:             if ($selected eq '') {
                   4854:                 $defsel = ' selected="selected"';
                   4855:             }
                   4856:             $output .= '<select name="deeplink_'.$item.'_'.$thiskey.'"'.$disabled.'>'."\n".
                   4857:                        '<option value=""'.$defsel.'>'.&mt('Please select').'</option>'."\n";
                   4858:             foreach my $option (@{$options{$item}}) {
                   4859:                 $output .= '<option value="'.$option.'"';
                   4860:                 if ($option eq $selected) {
                   4861:                     $output .= ' selected="selected"';
                   4862:                 }
                   4863:                 $output .= '>'.$optiontext{$option}.'</option>';
                   4864:             }
                   4865:             $output .= '</select>';
                   4866:         }
                   4867:         $output .= '</td>';
                   4868:     }
                   4869:     $output .= '</tr></table>'."\n";
                   4870:     return $output;
                   4871: }
                   4872: 
1.560     damieng  4873: 
                   4874: { # block using some constants related to parameter types (overview mode)
                   4875: 
1.446     bisitz   4876: my %strings =
1.383     albertel 4877:     (
                   4878:      'string_yesno'
                   4879:              => [[ 'yes', 'Yes' ],
1.560     damieng  4880:                  [ 'no', 'No' ]],
1.383     albertel 4881:      'string_problemstatus'
                   4882:              => [[ 'yes', 'Yes' ],
1.473     amueller 4883:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4884:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4885:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4886:      'string_questiontype'
                   4887:              => [[ 'problem', 'Standard Problem'],
                   4888:                  [ 'survey', 'Survey'],
                   4889:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4890:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4891:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4892:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4893:                  [ 'practice', 'Practice'],
                   4894:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4895:      'string_lenient'
                   4896:              => [['yes', 'Yes' ],
                   4897:                  [ 'no', 'No' ],
1.549     raeburn  4898:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4899:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4900:      'string_discussvote'
                   4901:              => [['yes','Yes'],
                   4902:                  ['notended','Yes, unless discussion ended'],
                   4903:                  ['no','No']],
1.549     raeburn  4904:      'string_ip'
                   4905:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
1.587     raeburn  4906:                  ['_denyfrom_','Hostname(s) or IP(s) from which access is disallowed']], 
                   4907:      'string_deeplink'
1.588     raeburn  4908:              => [['on','Set choices for link protection, resource listing, and access scope']],
1.587     raeburn  4909:     );
                   4910:    
1.383     albertel 4911: 
1.549     raeburn  4912: my %stringmatches = (
                   4913:          'string_lenient'
                   4914:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4915:          'string_ip'
                   4916:               => [['_allowfrom_','[^\!]+'],
                   4917:                   ['_denyfrom_','\!']],
1.588     raeburn  4918:          'string_deeplink'
                   4919:               => [['on','^(full|absent|grades|details|datestatus)\,(res|map|rec)\,(any|only|key\:\w+|lti\:\d+)$']],
1.549     raeburn  4920:     );
                   4921: 
                   4922: my %stringtypes = (
                   4923:                     type         => 'string_questiontype',
                   4924:                     lenient      => 'string_lenient',
                   4925:                     retrypartial => 'string_yesno',
                   4926:                     discussvote  => 'string_discussvote',
                   4927:                     examcode     => 'string_examcode',
                   4928:                     acc          => 'string_ip',
1.587     raeburn  4929:                     deeplink     => 'string_deeplink',
1.549     raeburn  4930:                   );
                   4931: 
1.563     damieng  4932: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4933: # Used by courseprefs.
                   4934: #
                   4935: # @param {string} $string_type - a parameter type for strings
                   4936: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4937: sub standard_string_options {
                   4938:     my ($string_type) = @_;
                   4939:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4940:         return $strings{$string_type};
                   4941:     }
                   4942:     return;
                   4943: }
1.383     albertel 4944: 
1.563     damieng  4945: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4946: #
                   4947: # @param {string} $string_type - a parameter type for strings
                   4948: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4949: sub standard_string_matches {
                   4950:     my ($string_type) = @_;
                   4951:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4952:         return $stringmatches{$string_type};
                   4953:     }
                   4954:     return;
                   4955: }
                   4956: 
1.563     damieng  4957: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4958: #
                   4959: # @param {string} $name - parameter name
                   4960: # @returns {string}
1.549     raeburn  4961: sub get_stringtype {
                   4962:     my ($name) = @_;
                   4963:     if (exists($stringtypes{$name})) {
                   4964:         return $stringtypes{$name};
                   4965:     }
                   4966:     return;
                   4967: }
                   4968: 
1.563     damieng  4969: # Returns HTML to edit a string parameter.
                   4970: #
                   4971: # @param {string} $thistype - parameter type
                   4972: # @param {string} $thiskey - parameter key
                   4973: # @param {string} $showval - parameter current value
                   4974: # @param {string} $name - parameter name
                   4975: # @param {boolean} $readonly - true if the values should not be made editable
                   4976: # @returns {string}
1.383     albertel 4977: sub string_selector {
1.552     raeburn  4978:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4979: 
1.383     albertel 4980:     if (!exists($strings{$thistype})) {
1.552     raeburn  4981:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4982:     }
                   4983: 
1.504     raeburn  4984:     my %skiptype;
1.514     raeburn  4985:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4986:             ($thistype eq 'string_lenient') ||
                   4987:             ($thistype eq 'string_discussvote') ||
                   4988:             ($thistype eq 'string_ip') ||
1.588     raeburn  4989:             ($thistype eq 'string_deeplink') ||
1.560     damieng  4990:             ($name eq 'retrypartial')) {
1.504     raeburn  4991:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4992:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4993:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4994:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4995:             my $parmmatch;
                   4996:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   4997:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   4998:                     if (ref($item) eq 'ARRAY') {
                   4999:                         if ($parmval eq $item->[0]) {
                   5000:                             $parmmatch = $parmval;
                   5001:                             $parmval = '';
                   5002:                             last;
                   5003:                         }
                   5004:                     }
                   5005:                 }
                   5006:             }
                   5007:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  5008:             if ($needsrelease) {
                   5009:                 unless ($got_chostname) {
1.514     raeburn  5010:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  5011:                     $got_chostname = 1;
                   5012:                 }
1.557     raeburn  5013:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  5014:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  5015:                 if ($needsnewer) {
1.549     raeburn  5016:                     if ($parmmatch ne '') {
                   5017:                         $skiptype{$parmmatch} = 1;
                   5018:                     } elsif ($parmval ne '') {
                   5019:                         $skiptype{$parmval} = 1;
                   5020:                     }
1.504     raeburn  5021:                 }
                   5022:             }
                   5023:         }
                   5024:     }
1.549     raeburn  5025: 
                   5026:     if ($thistype eq 'string_ip') {
1.552     raeburn  5027:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.588     raeburn  5028:     } elsif ($thistype eq 'string_deeplink') {
                   5029:         return &string_deeplink_selector($thiskey,$showval,$readonly);
1.549     raeburn  5030:     }
1.504     raeburn  5031: 
1.552     raeburn  5032:     my ($result,$disabled);
                   5033: 
                   5034:     if ($readonly) {
                   5035:         $disabled = ' disabled="disabled"';
                   5036:     }
1.504     raeburn  5037:     my $numinrow = 3;
                   5038:     if ($thistype eq 'string_problemstatus') {
                   5039:         $numinrow = 2;
                   5040:     } elsif ($thistype eq 'string_questiontype') {
                   5041:         if (keys(%skiptype) > 0) {
                   5042:              $numinrow = 4;
                   5043:         }
                   5044:     }
                   5045:     my $rem;
                   5046:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   5047:         my $i=0;
                   5048:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   5049:             next unless (ref($possibilities) eq 'ARRAY');
                   5050:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  5051:             next if ($skiptype{$name});
1.504     raeburn  5052:             $rem = $i%($numinrow);
                   5053:             if ($rem == 0) {
                   5054:                 if ($i > 0) {
                   5055:                     $result .= '</tr>';
                   5056:                 }
                   5057:                 $result .= '<tr>';
                   5058:             }
1.549     raeburn  5059:             my $colspan;
                   5060:             if ($i == @{ $strings{$thistype} }-1) {
                   5061:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   5062:                 if ($rem) {
                   5063:                     my $colsleft = $numinrow - $rem;
                   5064:                     if ($colsleft) {
                   5065:                         $colspan = $colsleft+1;
                   5066:                         $colspan = ' colspan="'.$colspan.'"';
                   5067:                     }
                   5068:                 }
                   5069:             }
                   5070:             my ($add,$onchange,$css_class);
                   5071:             if ($thistype eq 'string_lenient') {
                   5072:                 if ($name eq 'weighted') {
                   5073:                     my $display;
                   5074:                     my %relatives = &Apache::lonlocal::texthash(
                   5075:                                         corrchkd     => 'Correct (checked)',
                   5076:                                         corrunchkd   => 'Correct (unchecked)',
                   5077:                                         incorrchkd   => 'Incorrect (checked)',
                   5078:                                         incorrunchkd => 'Incorrect (unchecked)',
                   5079:                     );
                   5080:                     my %textval = (
                   5081:                                     corrchkd     => '1.0',
                   5082:                                     corrunchkd   => '1.0',
                   5083:                                     incorrchkd   => '0.0',
                   5084:                                     incorrunchkd => '0.0',
                   5085:                     );
                   5086:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   5087:                         $textval{'corrchkd'} = $1;
                   5088:                         $textval{'corrunchkd'} = $2;
                   5089:                         $textval{'incorrchkd'} = $3;
                   5090:                         $textval{'incorrunchkd'} = $4;
                   5091:                         $display = 'inline';
                   5092:                         $showval = $name;
                   5093:                     } else {
                   5094:                         $display = 'none';
                   5095:                     }
                   5096:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   5097:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   5098:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   5099:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   5100:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  5101:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  5102:                                 '</td></tr>';
                   5103:                     }
                   5104:                     $add .= '</table></div>'."\n";
                   5105:                 }
                   5106:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   5107:                 $css_class = ' class="LC_lenient_radio"';
                   5108:             }
                   5109:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  5110:                        '<span class="LC_nobreak"><label>'.
                   5111:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  5112:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  5113:             if ($showval eq $name) {
                   5114:                 $result .= ' checked="checked"';
                   5115:             }
1.549     raeburn  5116:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  5117:             $i++;
                   5118:         }
                   5119:         $result .= '</tr>';
1.473     amueller 5120:     }
1.504     raeburn  5121:     if ($result) {
                   5122:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 5123:     }
                   5124:     return $result;
                   5125: }
                   5126: 
1.554     raeburn  5127: my %intervals =
                   5128:     (
                   5129:      'date_interval'
                   5130:              => [[ 'done', 'Yes' ],
1.558     raeburn  5131:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  5132:                  [ '', 'No' ]],
                   5133:     );
                   5134: 
                   5135: my %intervalmatches = (
                   5136:          'date_interval'
1.559     raeburn  5137:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   5138:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  5139:     );
                   5140: 
                   5141: my %intervaltypes = (
                   5142:                       interval => 'date_interval',
                   5143:     );
                   5144: 
1.563     damieng  5145: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   5146: #
                   5147: # @param {string} $interval_type - a parameter type for intervals
                   5148: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  5149: sub standard_interval_matches {
                   5150:     my ($interval_type) = @_;
                   5151:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   5152:         return $intervalmatches{$interval_type};
                   5153:     }
                   5154:     return;
                   5155: }
                   5156: 
1.563     damieng  5157: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   5158: #
                   5159: # @param {string} $name - parameter name
                   5160: # @returns {string}
1.554     raeburn  5161: sub get_intervaltype {
                   5162:     my ($name) = @_;
                   5163:     if (exists($intervaltypes{$name})) {
                   5164:         return $intervaltypes{$name};
                   5165:     }
                   5166:     return;
                   5167: }
                   5168: 
1.563     damieng  5169: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   5170: # Used by courseprefs.
                   5171: #
                   5172: # @param {string} $interval_type - a parameter type for intervals
                   5173: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  5174: sub standard_interval_options {
                   5175:     my ($interval_type) = @_;
                   5176:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   5177:         return $intervals{$interval_type};
                   5178:     }
                   5179:     return;
                   5180: }
                   5181: 
1.563     damieng  5182: # Returns HTML to edit a date interval parameter.
                   5183: #
                   5184: # @param {string} $thiskey - parameter key
                   5185: # @param {string} $name - parameter name
                   5186: # @param {string} $showval - parameter current value
                   5187: # @param {boolean} $readonly - true if the values should not be made editable
                   5188: # @returns {string}
1.554     raeburn  5189: sub date_interval_selector {
                   5190:     my ($thiskey, $name, $showval, $readonly) = @_;
                   5191:     my ($result,%skipval);
                   5192:     if ($name eq 'interval') {
                   5193:         my $intervaltype = &get_intervaltype($name);
                   5194:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   5195:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   5196:             next unless (ref($possibilities) eq 'ARRAY');
                   5197:             my ($parmval, $description) = @{ $possibilities };
                   5198:             my $parmmatch;
                   5199:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   5200:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   5201:                     if (ref($item) eq 'ARRAY') {
                   5202:                         if ($parmval eq $item->[0]) {
                   5203:                             $parmmatch = $parmval;
                   5204:                             $parmval = '';
                   5205:                             last;
                   5206:                         }
                   5207:                     }
                   5208:                 }
                   5209:             }
                   5210:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   5211:             if ($needsrelease) {
                   5212:                 unless ($got_chostname) {
                   5213:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   5214:                     $got_chostname = 1;
                   5215:                 }
1.557     raeburn  5216:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  5217:                                                        $needsrelease,$cmajor,$cminor);
                   5218:                 if ($needsnewer) {
                   5219:                     if ($parmmatch ne '') {
                   5220:                         $skipval{$parmmatch} = 1;
                   5221:                     } elsif ($parmval ne '') {
                   5222:                         $skipval{$parmval} = 1;
                   5223:                     }
                   5224:                 }
                   5225:             }
                   5226:         }
                   5227:     }
                   5228: 
                   5229:     my $currval = $showval;
                   5230:     foreach my $which (['days', 86400, 31],
                   5231:                ['hours', 3600, 23],
                   5232:                ['minutes', 60, 59],
                   5233:                ['seconds',  1, 59]) {
1.560     damieng  5234:         my ($name, $factor, $max) = @{ $which };
                   5235:         my $amount = int($showval/$factor);
                   5236:         $showval  %= $factor;
                   5237:         my %select = ((map {$_ => $_} (0..$max)),
                   5238:                 'select_form_order' => [0..$max]);
                   5239:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   5240:                             \%select,'',$readonly);
                   5241:         $result .= ' '.&mt($name);
1.554     raeburn  5242:     }
                   5243:     if ($name eq 'interval') {
                   5244:         unless ($skipval{'done'}) {
                   5245:             my $checkedon = '';
1.558     raeburn  5246:             my $checkedproc = '';
                   5247:             my $currproctorkey = '';
                   5248:             my $currprocdisplay = 'hidden';
1.559     raeburn  5249:             my $currdonetext = &mt('Done');
1.554     raeburn  5250:             my $checkedoff = ' checked="checked"';
1.559     raeburn  5251:             if ($currval =~ /^(?:\d+)_done$/) {
                   5252:                 $checkedon = ' checked="checked"';
                   5253:                 $checkedoff = '';
                   5254:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   5255:                 $currdonetext = $1;
1.554     raeburn  5256:                 $checkedon = ' checked="checked"';
                   5257:                 $checkedoff = '';
1.558     raeburn  5258:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   5259:                 $currproctorkey = $1;
                   5260:                 $checkedproc = ' checked="checked"';
                   5261:                 $checkedoff = '';
                   5262:                 $currprocdisplay = 'text';
1.559     raeburn  5263:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   5264:                 $currdonetext = $1;
                   5265:                 $currproctorkey = $2;
                   5266:                 $checkedproc = ' checked="checked"';
                   5267:                 $checkedoff = '';
                   5268:                 $currprocdisplay = 'text';
1.554     raeburn  5269:             }
1.558     raeburn  5270:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  5271:             my $disabled;
                   5272:             if ($readonly) {
                   5273:                 $disabled = ' disabled="disabled"';
                   5274:             }
1.558     raeburn  5275:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  5276:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  5277:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  5278:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  5279:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  5280:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  5281:                        &mt('Yes, with proctor key').'</label>'.
                   5282:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  5283:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  5284:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  5285:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  5286:         }
                   5287:     }
                   5288:     unless ($readonly) {
                   5289:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   5290:     }
                   5291:     return $result;
                   5292: }
                   5293: 
1.563     damieng  5294: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   5295: #
                   5296: # @param {string} $name - parameter name
                   5297: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5298: # @param {string} $value - parameter value
                   5299: # @param {string} $chostname - course server name
                   5300: # @param {integer} $cmajor - major version number
                   5301: # @param {integer} $cminor - minor version number
                   5302: # @param {string} $needsrelease - release version needed (major.minor)
                   5303: # @returns {string}
1.549     raeburn  5304: sub oldversion_warning {
1.557     raeburn  5305:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   5306:     my $standard_name = &standard_parameter_names($name);
                   5307:     if ($namematch) {
                   5308:         my $level = &standard_parameter_levels($namematch);
                   5309:         my $msg = '';
                   5310:         if ($level) {
                   5311:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   5312:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   5313:         } else {
                   5314:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   5315:                       $standard_name,'<b>','</b>');
                   5316:         }
                   5317:         return '<p class="LC_warning">'.$msg.'<br />'.
                   5318:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5319:                    $cmajor.'.'.$cminor,$chostname,
                   5320:                    $needsrelease).
                   5321:                    '</p>';
                   5322:     }
1.549     raeburn  5323:     my $desc;
                   5324:     my $stringtype = &get_stringtype($name);
                   5325:     if ($stringtype ne '') {
                   5326:         if ($name eq 'examcode') {
                   5327:             $desc = $value;
                   5328:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   5329:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   5330:                 next unless (ref($possibilities) eq 'ARRAY');
                   5331:                 my ($parmval, $description) = @{ $possibilities };
                   5332:                 my $parmmatch;
                   5333:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   5334:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   5335:                         if (ref($item) eq 'ARRAY') {
                   5336:                             my ($regexpname,$pattern) = @{$item};
                   5337:                             if ($parmval eq $regexpname) {
                   5338:                                 if ($value =~ /$pattern/) {
                   5339:                                     $desc = $description; 
                   5340:                                     $parmmatch = 1;
                   5341:                                     last;
                   5342:                                 }
                   5343:                             }
                   5344:                         }
                   5345:                     }
                   5346:                     last if ($parmmatch);
                   5347:                 } elsif ($parmval eq $value) {
                   5348:                     $desc = $description;
                   5349:                     last;
                   5350:                 }
                   5351:             }
                   5352:         }
                   5353:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   5354:         my $now = time;
                   5355:         if ($value =~ /^\d+$/) {
                   5356:             if ($name eq 'printstartdate') {
                   5357:                 if ($value > $now) {
                   5358:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5359:                 }
                   5360:             } elsif ($name eq 'printenddate') {
                   5361:                 if ($value < $now) {
                   5362:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5363:                 }
                   5364:             }
                   5365:         }
                   5366:     }
                   5367:     return '<p class="LC_warning">'.
1.557     raeburn  5368:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   5369:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   5370:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5371:        $cmajor.'.'.$cminor,$chostname,
                   5372:        $needsrelease).
                   5373:        '</p>';
1.549     raeburn  5374: }
                   5375: 
1.560     damieng  5376: } # end of block using some constants related to parameter types
                   5377: 
1.549     raeburn  5378: 
1.563     damieng  5379: 
                   5380: # Shifts all start and end dates in the current course by $shift.
1.389     www      5381: #
1.563     damieng  5382: # @param {integer} $shift - time to shift, in seconds
                   5383: # @returns {string} - error name or 'ok'
1.389     www      5384: sub dateshift {
                   5385:     my ($shift)=@_;
                   5386:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5387:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5388:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   5389: # ugly retro fix for broken version of types
1.548     raeburn  5390:     foreach my $key (keys(%data)) {
1.389     www      5391:         if ($key=~/\wtype$/) {
                   5392:             my $newkey=$key;
                   5393:             $newkey=~s/type$/\.type/;
                   5394:             $data{$newkey}=$data{$key};
                   5395:             delete $data{$key};
                   5396:         }
                   5397:     }
1.391     www      5398:     my %storecontent=();
1.389     www      5399: # go through all parameters and look for dates
1.548     raeburn  5400:     foreach my $key (keys(%data)) {
1.389     www      5401:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   5402:           my $newdate=$data{$key}+$shift;
1.391     www      5403:           $storecontent{$key}=$newdate;
1.389     www      5404:        }
                   5405:     }
1.391     www      5406:     my $reply=&Apache::lonnet::cput
                   5407:                 ('resourcedata',\%storecontent,$dom,$crs);
                   5408:     if ($reply eq 'ok') {
                   5409:        &log_parmset(\%storecontent);
                   5410:     }
                   5411:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   5412:     return $reply;
1.389     www      5413: }
                   5414: 
1.563     damieng  5415: # Overview mode UI to edit course parameters.
                   5416: #
                   5417: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5418: sub newoverview {
1.568     raeburn  5419:     my ($r,$parm_permission) = @_;
1.280     albertel 5420: 
1.208     www      5421:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5422:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5423:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5424:     my $readonly = 1;
                   5425:     if ($parm_permission->{'edit'}) {
                   5426:         undef($readonly);
                   5427:     }
1.414     droeschl 5428:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5429:         text=>"Overview Mode"});
1.523     raeburn  5430: 
                   5431:     my %loaditems = (
1.549     raeburn  5432:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5433:                     );
                   5434:     my $js = '
                   5435: <script type="text/javascript">
                   5436: // <![CDATA[
                   5437: '.
                   5438:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5439:             &showhide_js()."\n".
1.549     raeburn  5440:             &toggleparmtextbox_js()."\n".
                   5441:             &validateparms_js()."\n".
                   5442:             &ipacc_boxes_js()."\n".
1.558     raeburn  5443:             &done_proctor_js()."\n".
1.588     raeburn  5444:             &deeplink_js()."\n".
1.523     raeburn  5445: '// ]]>
                   5446: </script>
                   5447: ';
1.549     raeburn  5448: 
1.523     raeburn  5449:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5450:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5451:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5452:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5453:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5454:     $r->print(<<ENDOVER);
1.549     raeburn  5455: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5456: ENDOVER
1.211     www      5457:     my @ids=();
                   5458:     my %typep=();
                   5459:     my %keyp=();
                   5460:     my %allparms=();
                   5461:     my %allparts=();
                   5462:     my %allmaps=();
                   5463:     my %mapp=();
                   5464:     my %symbp=();
                   5465:     my %maptitles=();
                   5466:     my %uris=();
                   5467:     my %keyorder=&standardkeyorder();
                   5468:     my %defkeytype=();
                   5469: 
                   5470:     my %alllevs=();
                   5471:     $alllevs{'Resource Level'}='full';
1.215     www      5472:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5473:     $alllevs{'Course Level'}='general';
                   5474: 
                   5475:     my $csec=$env{'form.csec'};
1.269     raeburn  5476:     my $cgroup=$env{'form.cgroup'};
1.211     www      5477: 
                   5478:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5479:     my $pschp=$env{'form.pschp'};
1.506     www      5480: 
1.211     www      5481:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5482:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5483: 
1.446     bisitz   5484:     my @selected_sections =
1.473     amueller 5485:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5486:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5487:     foreach my $sec (@selected_sections) {
                   5488:         if ($sec eq 'all') {
1.211     www      5489:             @selected_sections = ('all');
                   5490:         }
                   5491:     }
1.552     raeburn  5492:     if ($env{'request.course.sec'} ne '') {
                   5493:         @selected_sections = ($env{'request.course.sec'});
                   5494:     }
1.269     raeburn  5495:     my @selected_groups =
                   5496:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5497: 
                   5498:     my $pssymb='';
                   5499:     my $parmlev='';
1.446     bisitz   5500: 
1.211     www      5501:     unless ($env{'form.parmlev'}) {
                   5502:         $parmlev = 'map';
                   5503:     } else {
                   5504:         $parmlev = $env{'form.parmlev'};
                   5505:     }
                   5506: 
1.446     bisitz   5507:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5508:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5509:                 \%keyorder,\%defkeytype);
1.211     www      5510: 
1.374     albertel 5511:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5512:         @psprt = keys(%allparts);
1.374     albertel 5513:     }
1.211     www      5514: # Menu to select levels, etc
                   5515: 
1.456     bisitz   5516:     $r->print('<div class="LC_Box">');
1.445     neumanie 5517:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5518:     $r->print('<div>');
1.523     raeburn  5519:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5520:     &levelmenu($r,\%alllevs,$parmlev);
                   5521:     if ($parmlev ne 'general') {
1.447     bisitz   5522:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5523:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5524:     }
1.447     bisitz   5525:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5526:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5527:     $r->print('</div></div>');
1.446     bisitz   5528: 
1.456     bisitz   5529:     $r->print('<div class="LC_Box">');
1.452     bisitz   5530:     $r->print('<div>');
1.581     raeburn  5531:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5532:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5533:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5534:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5535:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5536:     $r->print('<table>'.
1.553     raeburn  5537:               '<tr><th>'.&mt('Parts').'</th>');
                   5538:     if ($sectionselector) {
                   5539:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5540:     }
                   5541:     if ($groupselector) {
                   5542:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5543:     }
                   5544:     $r->print('</tr><tr><td>');
1.211     www      5545:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5546:     $r->print('</td>');
                   5547:     if ($sectionselector) { 
                   5548:         $r->print('<td>'.$sectionselector.'</td>');
                   5549:     }
                   5550:     if ($groupselector) {
                   5551:         $r->print('<td>'.$groupselector.'</td>');
                   5552:     }
                   5553:     $r->print('</tr></table>');
1.447     bisitz   5554:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5555:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5556:     $r->print('</div></div>');
                   5557: 
1.456     bisitz   5558:     $r->print('<div class="LC_Box">');
1.452     bisitz   5559:     $r->print('<div>');
1.214     www      5560:     my $sortorder=$env{'form.sortorder'};
                   5561:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5562:     &sortmenu($r,$sortorder);
1.445     neumanie 5563:     $r->print('</div></div>');
1.446     bisitz   5564: 
1.214     www      5565:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5566: 
1.211     www      5567: # Build the list data hash from the specified parms
                   5568: 
                   5569:     my $listdata;
                   5570:     %{$listdata}=();
                   5571: 
                   5572:     foreach my $cat (@pscat) {
1.269     raeburn  5573:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5574:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5575:     }
                   5576: 
1.212     www      5577:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5578: 
1.481     amueller 5579:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5580: 
                   5581: # Read modified data
                   5582: 
1.481     amueller 5583:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5584: 
                   5585: # List data
                   5586: 
1.568     raeburn  5587:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5588:     }
                   5589:     $r->print(&tableend());
                   5590:     unless ($readonly) {
                   5591:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5592:     }
1.568     raeburn  5593:     $r->print('</form>');
1.507     www      5594:     &endSettingsScreen($r);
                   5595:     $r->print(&Apache::loncommon::end_page());
1.208     www      5596: }
                   5597: 
1.563     damieng  5598: # Fills $listdata with parameter information.
                   5599: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5600: # The non-type value is always 1.
                   5601: #
                   5602: # @param {string} $cat - parameter name
1.566     damieng  5603: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5604: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5605: # @param {hash reference} $listdata - the parameter data that will be modified
                   5606: # @param {array reference} $psprt - selected parts
                   5607: # @param {array reference} $selections - selected sections
                   5608: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5609: # @param {hash reference} $allmaps - hash map pc -> map src
                   5610: # @param {array reference} $ids - resource and map ids
                   5611: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5612: sub secgroup_lister {
                   5613:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5614:     foreach my $item (@{$selections}) {
                   5615:         foreach my $part (@{$psprt}) {
                   5616:             my $rootparmkey=$env{'request.course.id'};
                   5617:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5618:                 $rootparmkey.='.['.$item.']';
                   5619:             }
                   5620:             if ($parmlev eq 'general') {
                   5621: # course-level parameter
                   5622:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5623:                 $$listdata{$newparmkey}=1;
                   5624:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5625:             } elsif ($parmlev eq 'map') {
                   5626: # map-level parameter
1.548     raeburn  5627:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5628:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5629:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5630:                     $$listdata{$newparmkey}=1;
                   5631:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5632:                 }
                   5633:             } else {
                   5634: # resource-level parameter
                   5635:                 foreach my $rid (@{$ids}) {
                   5636:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5637:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5638:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5639:                     $$listdata{$newparmkey}=1;
                   5640:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5641:                 }
                   5642:             }
                   5643:         }
                   5644:     }
                   5645: }
                   5646: 
1.563     damieng  5647: # UI to edit parameter settings starting with a list of all existing parameters.
                   5648: # (called by setoverview action)
                   5649: #
                   5650: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5651: sub overview {
1.568     raeburn  5652:     my ($r,$parm_permission) = @_;
1.208     www      5653:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5654:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5655:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5656:     my $readonly = 1;
                   5657:     if ($parm_permission->{'edit'}) {
                   5658:         undef($readonly);
                   5659:     }
1.549     raeburn  5660:     my $js = '<script type="text/javascript">'."\n".
                   5661:              '// <![CDATA['."\n".
                   5662:              &toggleparmtextbox_js()."\n".
                   5663:              &validateparms_js()."\n".
                   5664:              &ipacc_boxes_js()."\n".
1.558     raeburn  5665:              &done_proctor_js()."\n".
1.588     raeburn  5666:              &deeplink_js()."\n".
1.549     raeburn  5667:              '// ]]>'."\n".
                   5668:              '</script>'."\n";
1.414     droeschl 5669:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5670:     text=>"Overview Mode"});
1.549     raeburn  5671:     my %loaditems = (
                   5672:                       'onload'   => "showHideLenient();",
                   5673:                     );
                   5674: 
                   5675:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5676:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5677:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5678:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5679:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5680: 
1.208     www      5681: # Store modified
                   5682: 
1.568     raeburn  5683:     unless ($readonly) {
                   5684:         &storedata($r,$crs,$dom);
                   5685:     }
1.208     www      5686: 
                   5687: # Read modified data
                   5688: 
1.552     raeburn  5689:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5690: 
1.214     www      5691: 
                   5692:     my $sortorder=$env{'form.sortorder'};
                   5693:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5694:     &sortmenu($r,$sortorder);
                   5695: 
1.568     raeburn  5696:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5697: 
                   5698:     if ($readonly) {
                   5699:         $r->print('<p>'.$submitbutton.'</p>');
                   5700:     }
                   5701: 
1.208     www      5702: # List data
                   5703: 
1.568     raeburn  5704:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5705:     $r->print(&tableend().'<p>');
                   5706:     if ($foundkeys) {
                   5707:         unless ($readonly) {
                   5708:             $r->print('<p>'.$submitbutton.'</p>');
                   5709:         }
                   5710:     } else {
                   5711:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5712:     }
                   5713:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5714: }
1.121     www      5715: 
1.560     damieng  5716: # Unused sub.
1.563     damieng  5717: #
                   5718: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5719: sub clean_parameters {
                   5720:     my ($r) = @_;
                   5721:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5722:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5723: 
1.414     droeschl 5724:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5725:         text=>"Clean Parameters"});
1.333     albertel 5726:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5727:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5728:     $r->print(<<ENDOVER);
                   5729: $start_page
                   5730: $breadcrumbs
                   5731: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5732: ENDOVER
                   5733: # Store modified
                   5734: 
                   5735:     &storedata($r,$crs,$dom);
                   5736: 
                   5737: # Read modified data
                   5738: 
                   5739:     my $resourcedata=&readdata($crs,$dom);
                   5740: 
                   5741: # List data
                   5742: 
                   5743:     $r->print('<h3>'.
1.473     amueller 5744:           &mt('These parameters refer to resources that do not exist.').
                   5745:           '</h3>'.
                   5746:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5747:           '<br />');
1.333     albertel 5748:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5749:           '<tr>'.
                   5750:           '<th>'.&mt('Delete').'</th>'.
                   5751:           '<th>'.&mt('Parameter').'</th>'.
                   5752:           '</tr>');
1.333     albertel 5753:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5754:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5755:             && $thiskey=~/\.type$/);
                   5756:         my %data = &parse_key($thiskey);
                   5757:         if (1) { #exists($data{'realm_exists'})
                   5758:             #&& !$data{'realm_exists'}) {
                   5759:             $r->print(&Apache::loncommon::start_data_table_row().
                   5760:                 '<tr>'.
                   5761:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5762: 
                   5763:             $r->print('<td>');
                   5764:             my $display_value = $resourcedata->{$thiskey};
                   5765:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5766:             $display_value =
                   5767:                 &Apache::lonlocal::locallocaltime($display_value);
                   5768:             }
1.470     raeburn  5769:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5770:             $parmitem = &mt($parmitem);
1.560     damieng  5771:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5772:                 $parmitem,$resourcedata->{$thiskey}));
                   5773:             $r->print('<br />');
                   5774:             if ($data{'scope_type'} eq 'all') {
                   5775:                 $r->print(&mt('All users'));
                   5776:             } elsif ($data{'scope_type'} eq 'user') {
                   5777:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581     raeburn  5778:             } elsif ($data{'scope_type'} eq 'secgroup') {
                   5779:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5780:             }
                   5781:             $r->print('<br />');
                   5782:             if ($data{'realm_type'} eq 'all') {
                   5783:                 $r->print(&mt('All Resources'));
                   5784:             } elsif ($data{'realm_type'} eq 'folder') {
                   5785:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5786:             } elsif ($data{'realm_type'} eq 'symb') {
                   5787:             my ($map,$resid,$url) =
                   5788:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5789:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5790:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5791:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5792:             }
                   5793:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5794:             $r->print('</td></tr>');
                   5795: 
1.473     amueller 5796:         }
1.333     albertel 5797:     }
                   5798:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5799:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5800:           '</p></form>');
                   5801:     &endSettingsScreen($r);
                   5802:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5803: }
                   5804: 
1.563     damieng  5805: # UI to shift all dates (called by dateshift1 action).
                   5806: # Used by overview mode.
                   5807: #
                   5808: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5809: sub date_shift_one {
                   5810:     my ($r) = @_;
                   5811:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5812:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5813:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5814: 
1.414     droeschl 5815:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5816:         text=>"Shifting Dates"});
1.390     www      5817:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5818:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5819:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5820:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5821:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5822:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5823:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5824:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5825:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5826:                                                         'timeshifted',
                   5827:                                                         $env{'form.timebase'},,
                   5828:                                                         '').
                   5829:               '</td></tr></table>'.
                   5830:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5831:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5832:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5833:     &endSettingsScreen($r);
1.390     www      5834:     $r->print(&Apache::loncommon::end_page());
                   5835: }
                   5836: 
1.563     damieng  5837: # UI to shift all dates (second form).
                   5838: #
                   5839: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5840: sub date_shift_two {
                   5841:     my ($r) = @_;
                   5842:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5843:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5844:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5845:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5846:         text=>"Shifting Dates"});
1.390     www      5847:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5848:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5849:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5850:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5851:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5852:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5853:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5854:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5855:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5856:     my $delta=$timeshifted-$env{'form.timebase'};
                   5857:     &dateshift($delta);
1.543     bisitz   5858:     $r->print(
                   5859:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5860:         '<br /><br />'.
                   5861:         &Apache::lonhtmlcommon::actionbox(
                   5862:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5863:     &endSettingsScreen($r);
1.390     www      5864:     $r->print(&Apache::loncommon::end_page());
                   5865: }
                   5866: 
1.563     damieng  5867: # Returns the different components of a resourcedata key.
                   5868: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5869: #       realm_exists, parameter_part, parameter_name.
                   5870: # Was used by clean_parameters (which is unused).
                   5871: #
                   5872: # @param {string} $key - the parameter key
                   5873: # @returns {hash}
1.333     albertel 5874: sub parse_key {
                   5875:     my ($key) = @_;
                   5876:     my %data;
                   5877:     my ($middle,$part,$name)=
1.572     damieng  5878:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5879:     $data{'scope_type'} = 'all';
                   5880:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5881:         $data{'scope'} = $1;
                   5882:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5883:             $data{'scope_type'} = 'user';
                   5884:             $data{'scope'} = [$1,$2];
                   5885:         } else {
1.581     raeburn  5886:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5887:         }
                   5888:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5889:     }
                   5890:     $middle=~s/\.+$//;
                   5891:     $middle=~s/^\.+//;
                   5892:     $data{'realm_type'}='all';
                   5893:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5894:         $data{'realm'} = $1;
                   5895:         $data{'realm_type'} = 'folder';
                   5896:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5897:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5898:     } elsif ($middle) {
1.560     damieng  5899:         $data{'realm'} = $middle;
                   5900:         $data{'realm_type'} = 'symb';
                   5901:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5902:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5903:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5904:     }
1.446     bisitz   5905: 
1.333     albertel 5906:     $data{'parameter_part'} = $part;
                   5907:     $data{'parameter_name'} = $name;
                   5908: 
                   5909:     return %data;
                   5910: }
                   5911: 
1.239     raeburn  5912: 
1.563     damieng  5913: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5914: sub header {
1.507     www      5915:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5916: }
1.193     albertel 5917: 
                   5918: 
                   5919: 
1.560     damieng  5920: ##################################################
                   5921: # MAIN MENU
                   5922: ##################################################
                   5923: 
1.563     damieng  5924: # Content and problem settings main menu.
                   5925: #
                   5926: # @param {Apache2::RequestRec} $r - the Apache request
                   5927: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5928: sub print_main_menu {
                   5929:     my ($r,$parm_permission)=@_;
                   5930:     #
1.414     droeschl 5931:     $r->print(&header());
1.507     www      5932:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5933:     my $crstype = &Apache::loncommon::course_type();
                   5934:     my $lc_crstype = lc($crstype);
                   5935: 
                   5936:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5937:     $r->print(<<ENDMAINFORMHEAD);
                   5938: <form method="post" enctype="multipart/form-data"
                   5939:       action="/adm/parmset" name="studentform">
                   5940: ENDMAINFORMHEAD
                   5941: #
1.195     albertel 5942:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5943:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5944:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5945:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5946:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  5947:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   5948:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  5949:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5950:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5951:                                         '/'.$env{'request.course.sec'});
                   5952:     }
1.568     raeburn  5953:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   5954:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   5955:                                         '/'.$env{'request.course.sec'});
                   5956:     }
                   5957:     my (%linktext,%linktitle,%url);
                   5958:     if ($parm_permission->{'edit'}) {
                   5959:         %linktext = (
                   5960:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   5961:                      settable        => 'Edit Resource Parameters - Table Mode',
                   5962:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   5963:                     );
                   5964:         %linktitle = (
                   5965:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   5966:                      settable        => 'Set/Modify resource parameters in table mode.',
                   5967:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   5968:                      );
                   5969:     } else {
                   5970:         %linktext = (
                   5971:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   5972:                      settable        => 'View Resource Parameters - Table Mode',
                   5973:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   5974:                    );
                   5975:         %linktitle = (
                   5976:                      newoverview     => 'Display resource parameters in overview mode.',
                   5977:                      settable        => 'Display resource parameters in table mode.',
                   5978:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   5979:                      );
                   5980:     }
                   5981:     if ($mgr) {
                   5982:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   5983:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   5984:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   5985:     } elsif ($vgr) {
                   5986:         $linktext{'resettimes'} = 'Display Student Access Times',
                   5987:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   5988:         $url{'resettimes'} = '/adm/accesstimes';
                   5989:     }
1.193     albertel 5990:     my @menu =
1.507     www      5991:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5992:         items => [
                   5993:           { linktext => 'Portfolio Metadata',
                   5994:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  5995:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  5996:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 5997:             icon =>'contact-new.png'   ,
                   5998:             },
1.568     raeburn  5999:           { linktext => $linktext{'resettimes'},
                   6000:             url => $url{'resettimes'},
                   6001:             permission => ($vgr || $mgr),
                   6002:             linktitle => $linktitle{'resettimes'},
                   6003:             icon => 'start-here.png',
1.473     amueller 6004:             },
1.520     raeburn  6005:           { linktext => 'Blocking Communication/Resource Access',
                   6006:             url => '/adm/setblock',
1.568     raeburn  6007:             permission => ($vcb || $dcm),
1.520     raeburn  6008:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   6009:             icon => 'comblock.png',
                   6010:             },
1.473     amueller 6011:           { linktext => 'Set Parameter Setting Default Actions',
                   6012:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  6013:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 6014:             linktitle =>'Set default actions for parameters.'  ,
                   6015:             icon => 'folder-new.png'  ,
                   6016:             }]},
                   6017:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   6018:         items => [
                   6019:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   6020:             url => '/adm/helper/parameter.helper',
1.568     raeburn  6021:             permission => $parm_permission->{'helper'},
1.473     amueller 6022:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   6023:             icon => 'dialog-information.png'  ,
                   6024:             #help => 'Parameter_Helper',
                   6025:             },
1.568     raeburn  6026:           { linktext => $linktext{'newoverview'},
1.473     amueller 6027:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  6028:             permission => $parm_permission->{'newoverview'},
                   6029:             linktitle => $linktitle{'newoverview'},
                   6030:             icon => 'edit-find.png',
1.473     amueller 6031:             #help => 'Parameter_Overview',
                   6032:             },
1.568     raeburn  6033:           { linktext => $linktext{'settable'},
1.473     amueller 6034:             url => '/adm/parmset?action=settable',
1.568     raeburn  6035:             permission => $parm_permission->{'settable'},
                   6036:             linktitle => $linktitle{'settable'},
                   6037:             icon => 'edit-copy.png',
1.473     amueller 6038:             #help => 'Table_Mode',
                   6039:             }]},
1.417     droeschl 6040:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 6041:          items => [
1.570     raeburn  6042:           { linktext => $linktext{'setoverview'},
1.473     amueller 6043:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  6044:             permission => $parm_permission->{'setoverview'},
                   6045:             linktitle => $linktitle{'setoverview'},
                   6046:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 6047:             #help => 'Parameter_Overview',
                   6048:             },
                   6049:           { linktext => 'Change Log',
                   6050:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  6051:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  6052:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 6053:             icon => 'document-properties.png',
1.473     amueller 6054:             }]}
1.193     albertel 6055:           );
1.414     droeschl 6056:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  6057:     $r->print('</form>');
1.507     www      6058:     &endSettingsScreen($r);
1.539     raeburn  6059:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 6060:     return;
                   6061: }
1.414     droeschl 6062: 
1.416     jms      6063: 
                   6064: 
1.560     damieng  6065: ##################################################
                   6066: # PORTFOLIO METADATA
                   6067: ##################################################
                   6068: 
1.563     damieng  6069: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   6070: # It looks like field titles are not localized.
                   6071: #
                   6072: # @param {Apache2::RequestRec} $r - the Apache request
                   6073: # @param {string} $field_name - metadata field name
                   6074: # @param {string} $field_text - metadata field title, in English unless manually added
                   6075: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 6076: sub output_row {
1.347     banghart 6077:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 6078:     my $output;
1.263     banghart 6079:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   6080:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 6081:     if (!defined($options)) {
1.254     banghart 6082:         $options = 'active,stuadd';
1.261     banghart 6083:         $values = '';
1.252     banghart 6084:     }
1.337     banghart 6085:     if (!($options =~ /deleted/)) {
                   6086:         my @options= ( ['active', 'Show to student'],
1.418     schafran 6087:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 6088:                     ['choices','Provide choices for students to select from']);
1.473     amueller 6089: #           ['onlyone','Student may select only one choice']);
1.337     banghart 6090:         if ($added_flag) {
                   6091:             push @options,['deleted', 'Delete Metadata Field'];
                   6092:         }
1.351     banghart 6093:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   6094:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 6095:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 6096:         foreach my $opt (@options) {
1.560     damieng  6097:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   6098:             $output .= &Apache::loncommon::continue_data_table_row();
                   6099:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   6100:                     <input type="checkbox" name="'.
                   6101:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   6102:                     &mt($opt->[1]).'</label></td>';
                   6103:             $output .= &Apache::loncommon::end_data_table_row();
                   6104:         }
1.351     banghart 6105:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   6106:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 6107:         $output .= &Apache::loncommon::end_data_table_row();
                   6108:         my $multiple_checked;
                   6109:         my $single_checked;
                   6110:         if ($options =~ m/onlyone/) {
1.422     bisitz   6111:             $multiple_checked = '';
1.423     bisitz   6112:             $single_checked = ' checked="checked"';
1.351     banghart 6113:         } else {
1.423     bisitz   6114:             $multiple_checked = ' checked="checked"';
1.422     bisitz   6115:             $single_checked = '';
1.351     banghart 6116:         }
1.560     damieng  6117:         $output .= &Apache::loncommon::continue_data_table_row();
                   6118:         $output .= '<td>'.('&nbsp;' x 10).'
                   6119:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   6120:                     '.&mt('Student may select multiple choices from list').'</td>';
                   6121:         $output .= &Apache::loncommon::end_data_table_row();
                   6122:         $output .= &Apache::loncommon::continue_data_table_row();
                   6123:         $output .= '<td>'.('&nbsp;' x 10).'
                   6124:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   6125:                     '.&mt('Student may select only one choice from list').'</td>';
                   6126:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 6127:     }
                   6128:     return ($output);
                   6129: }
1.416     jms      6130: 
                   6131: 
1.560     damieng  6132: # UI to order portfolio metadata fields.
1.563     damieng  6133: # Currently useless because addmetafield does not work.
                   6134: #
                   6135: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 6136: sub order_meta_fields {
                   6137:     my ($r)=@_;
                   6138:     my $idx = 1;
                   6139:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6140:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6141:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 6142:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  6143:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6144:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6145:         text=>"Add Metadata Field"});
1.560     damieng  6146:     &Apache::lonhtmlcommon::add_breadcrumb(
                   6147:         {href=>"/adm/parmset?action=setrestrictmeta",
                   6148:         text=>"Restrict Metadata"},
                   6149:         {text=>"Order Metadata"});
1.345     banghart 6150:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  6151:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 6152:     if ($env{'form.storeorder'}) {
                   6153:         my $newpos = $env{'form.newpos'} - 1;
                   6154:         my $currentpos = $env{'form.currentpos'} - 1;
                   6155:         my @neworder = ();
1.548     raeburn  6156:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6157:         my $i;
1.341     banghart 6158:         if ($newpos > $currentpos) {
1.340     banghart 6159:         # moving stuff up
                   6160:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  6161:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6162:             }
                   6163:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  6164:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 6165:             }
                   6166:             $neworder[$newpos]=$oldorder[$currentpos];
                   6167:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  6168:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 6169:             }
                   6170:         } else {
                   6171:         # moving stuff down
1.473     amueller 6172:             for ($i=0;$i<$newpos;$i++) {
                   6173:                 $neworder[$i]=$oldorder[$i];
                   6174:             }
                   6175:             $neworder[$newpos]=$oldorder[$currentpos];
                   6176:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   6177:                 $neworder[$i]=$oldorder[$i-1];
                   6178:             }
                   6179:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   6180:                 $neworder[$i]=$oldorder[$i];
                   6181:             }
1.340     banghart 6182:         }
1.560     damieng  6183:         my $ordered_fields = join ",", @neworder;
1.343     banghart 6184:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  6185:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6186:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 6187:     }
1.357     raeburn  6188:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 6189:     my $ordered_fields;
1.548     raeburn  6190:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 6191:     if (!@fields_in_order) {
                   6192:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  6193:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 6194:             push @fields_in_order, $key;
1.341     banghart 6195:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 6196:         }
1.341     banghart 6197:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   6198:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   6199:     }
1.340     banghart 6200:     $r->print('<table>');
                   6201:     my $num_fields = scalar(@fields_in_order);
                   6202:     foreach my $key (@fields_in_order) {
                   6203:         $r->print('<tr><td>');
                   6204:         $r->print('<form method="post" action="">');
1.537     bisitz   6205:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 6206:         for (my $i = 1;$i le $num_fields;$i ++) {
                   6207:             if ($i eq $idx) {
                   6208:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   6209:             } else {
                   6210:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   6211:             }
                   6212:         }
                   6213:         $r->print('</select></td><td>');
                   6214:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   6215:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   6216:         $r->print('</form>');
                   6217:         $r->print($$fields{$key}.'</td></tr>');
                   6218:         $idx ++;
                   6219:     }
                   6220:     $r->print('</table>');
1.507     www      6221:     &endSettingsScreen($r);
1.340     banghart 6222:     return 'ok';
                   6223: }
1.416     jms      6224: 
                   6225: 
1.563     damieng  6226: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   6227: # @returns {string}
1.359     banghart 6228: sub continue {
                   6229:     my $output;
                   6230:     $output .= '<form action="" method="post">';
                   6231:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
1.586     raeburn  6232:     $output .= '<input type="submit" value="'.&mt('Continue').'" />';
1.359     banghart 6233:     return ($output);
                   6234: }
1.416     jms      6235: 
                   6236: 
1.563     damieng  6237: # UI to add a metadata field.
                   6238: # Currenly does not work because of an HTML error (the field is not visible).
                   6239: #
                   6240: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 6241: sub addmetafield {
                   6242:     my ($r)=@_;
1.414     droeschl 6243:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 6244:         text=>"Add Metadata Field"});
1.334     banghart 6245:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   6246:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 6247:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6248:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6249:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6250:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 6251:     if (exists($env{'form.undelete'})) {
1.358     banghart 6252:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 6253:         foreach my $meta_field(@meta_fields) {
                   6254:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   6255:             $options =~ s/deleted//;
                   6256:             $options =~ s/,,/,/;
                   6257:             my $put_result = &Apache::lonnet::put('environment',
                   6258:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   6259: 
1.586     raeburn  6260:             $r->print(&mt('Undeleted Metadata Field [_1] with result [_2]',
                   6261:                           '<strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}.
                   6262:                           '</strong>',$put_result).
                   6263:                       '<br />');
1.339     banghart 6264:         }
1.359     banghart 6265:         $r->print(&continue());
1.339     banghart 6266:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 6267:         my $meta_field = $env{'form.fieldname'};
                   6268:         my $display_field = $env{'form.fieldname'};
                   6269:         $meta_field =~ s/\W/_/g;
1.338     banghart 6270:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 6271:         my $put_result = &Apache::lonnet::put('environment',
                   6272:                             {'metadata.'.$meta_field.'.values'=>"",
                   6273:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   6274:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.586     raeburn  6275:         $r->print(&mt('Added new Metadata Field [_1] with result [_2]',
                   6276:                       '<strong>'.$env{'form.fieldname'}.'</strong>',$put_result).
                   6277:                   '<br />');
1.359     banghart 6278:         $r->print(&continue());
1.335     banghart 6279:     } else {
1.357     raeburn  6280:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 6281:         if ($fields) {
1.586     raeburn  6282:             $r->print(&mt('You may undelete previously deleted fields.').
                   6283:                       '<br />'.
                   6284:                       &mt('Check those you wish to undelete and click Undelete.').
                   6285:                       '<br />');
1.339     banghart 6286:             $r->print('<form method="post" action="">');
                   6287:             foreach my $key(keys(%$fields)) {
1.581     raeburn  6288:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 6289:             }
1.586     raeburn  6290:             $r->print('<input type="submit" name="undelete" value="'.&mt('Undelete').'" />');
1.339     banghart 6291:             $r->print('</form>');
                   6292:         }
1.586     raeburn  6293:         $r->print('<hr />'.
                   6294:                   &mt('[_1]Or[_2] you may enter a new metadata field name.',
                   6295:                       '<strong>','</strong>').
1.581     raeburn  6296:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 6297:         $r->print('<input type="text" name="fieldname" /><br />');
1.586     raeburn  6298:         $r->print('<input type="submit" value="'.&mt('Add Metadata Field').'" />');
1.581     raeburn  6299:         $r->print('</form>');
1.334     banghart 6300:     }
1.507     www      6301:     &endSettingsScreen($r);
1.334     banghart 6302: }
1.416     jms      6303: 
                   6304: 
                   6305: 
1.560     damieng  6306: # Display or save portfolio metadata.
1.563     damieng  6307: #
                   6308: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 6309: sub setrestrictmeta {
1.240     banghart 6310:     my ($r)=@_;
1.242     banghart 6311:     my $next_meta;
1.244     banghart 6312:     my $output;
1.245     banghart 6313:     my $item_num;
1.246     banghart 6314:     my $put_result;
1.414     droeschl 6315:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 6316:         text=>"Restrict Metadata"});
1.280     albertel 6317:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 6318:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 6319:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6320:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6321:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6322:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 6323:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 6324:     my $save_field = '';
1.586     raeburn  6325:     my %lt = &Apache::lonlocal::texthash(
                   6326:                                            addm => 'Add Metadata Field',
                   6327:                                            ordm => 'Order Metadata Fields',
                   6328:                                            save => 'Save',
                   6329:                                         );
1.259     banghart 6330:     if ($env{'form.restrictmeta'}) {
1.254     banghart 6331:         foreach my $field (sort(keys(%env))) {
1.252     banghart 6332:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 6333:                 my $options;
1.252     banghart 6334:                 my $meta_field = $1;
                   6335:                 my $meta_key = $2;
1.253     banghart 6336:                 if ($save_field ne $meta_field) {
1.252     banghart 6337:                     $save_field = $meta_field;
1.473     amueller 6338:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   6339:                         $options.='stuadd,';
                   6340:                     }
                   6341:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   6342:                         $options.='choices,';
                   6343:                     }
                   6344:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   6345:                         $options.='onlyone,';
                   6346:                     }
                   6347:                     if ($env{'form.'.$meta_field.'_active'}) {
                   6348:                         $options.='active,';
                   6349:                     }
                   6350:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   6351:                         $options.='deleted,';
                   6352:                     }
1.259     banghart 6353:                     my $name = $save_field;
1.560     damieng  6354:                     $put_result = &Apache::lonnet::put('environment',
                   6355:                         {'metadata.'.$meta_field.'.options'=>$options,
                   6356:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   6357:                         },$dom,$crs);
1.252     banghart 6358:                 }
                   6359:             }
                   6360:         }
                   6361:     }
1.296     albertel 6362:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 6363:                        {'freshen_cache' => 1});
1.335     banghart 6364:     # Get the default metadata fields
1.258     albertel 6365:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 6366:     # Now get possible added metadata fields
1.357     raeburn  6367:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.347     banghart 6368:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 6369:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 6370:         if ($field ne 'courserestricted') {
1.586     raeburn  6371:             $output.= &output_row($r,$field,$metadata_fields{$field});
1.560     damieng  6372:         }
1.255     banghart 6373:     }
1.351     banghart 6374:     my $buttons = (<<ENDButtons);
1.586     raeburn  6375:         <input type="submit" name="restrictmeta" value="$lt{'save'}" />
1.351     banghart 6376:         </form><br />
                   6377:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
1.586     raeburn  6378:         <input type="submit" name="restrictmeta" value="$lt{'addm'}" />
1.351     banghart 6379:         </form>
                   6380:         <br />
                   6381:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
1.586     raeburn  6382:         <input type="submit" name="restrictmeta" value="$lt{'ordm'}" />
1.351     banghart 6383: ENDButtons
1.337     banghart 6384:     my $added_flag = 1;
1.335     banghart 6385:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.586     raeburn  6386:         $output.= &output_row($r,$field,$$added_metadata_fields{$field},$added_flag);
1.335     banghart 6387:     }
1.347     banghart 6388:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   6389:     $r->print(<<ENDenv);
1.259     banghart 6390:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 6391:         $output
1.351     banghart 6392:         $buttons
1.340     banghart 6393:         </form>
1.244     banghart 6394: ENDenv
1.507     www      6395:     &endSettingsScreen($r);
1.280     albertel 6396:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 6397:     return 'ok';
                   6398: }
1.416     jms      6399: 
                   6400: 
1.563     damieng  6401: # Returns metadata fields that have been manually added.
                   6402: #
                   6403: # @param {string} $cid - course id
                   6404: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 6405: sub get_added_meta_fieldnames {
1.357     raeburn  6406:     my ($cid) = @_;
1.335     banghart 6407:     my %fields;
                   6408:     foreach my $key(%env) {
1.357     raeburn  6409:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 6410:             my $field_name = $1;
                   6411:             my ($display_field_name) = $env{$key};
                   6412:             $fields{$field_name} = $display_field_name;
                   6413:         }
                   6414:     }
                   6415:     return \%fields;
                   6416: }
1.416     jms      6417: 
                   6418: 
1.563     damieng  6419: # Returns metadata fields that have been manually added and deleted.
                   6420: #
                   6421: # @param {string} $cid - course id
                   6422: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 6423: sub get_deleted_meta_fieldnames {
1.357     raeburn  6424:     my ($cid) = @_;
1.339     banghart 6425:     my %fields;
                   6426:     foreach my $key(%env) {
1.357     raeburn  6427:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 6428:             my $field_name = $1;
                   6429:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   6430:                 my ($display_field_name) = $env{$key};
                   6431:                 $fields{$field_name} = $display_field_name;
                   6432:             }
                   6433:         }
                   6434:     }
                   6435:     return \%fields;
                   6436: }
1.560     damieng  6437: 
                   6438: 
                   6439: ##################################################
                   6440: # PARAMETER SETTINGS DEFAULT ACTIONS
                   6441: ##################################################
                   6442: 
                   6443: # UI to change parameter setting default actions
1.563     damieng  6444: #
                   6445: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6446: sub defaultsetter {
1.280     albertel 6447:     my ($r) = @_;
                   6448: 
1.414     droeschl 6449:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6450:         text=>"Set Defaults"});
1.531     raeburn  6451:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6452:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6453:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6454:     my $start_page =
1.531     raeburn  6455:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6456:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6457:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6458:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6459:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6460: 
1.221     www      6461:     my @ids=();
                   6462:     my %typep=();
                   6463:     my %keyp=();
                   6464:     my %allparms=();
                   6465:     my %allparts=();
                   6466:     my %allmaps=();
                   6467:     my %mapp=();
                   6468:     my %symbp=();
                   6469:     my %maptitles=();
                   6470:     my %uris=();
                   6471:     my %keyorder=&standardkeyorder();
                   6472:     my %defkeytype=();
                   6473: 
1.446     bisitz   6474:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6475:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6476:                 \%keyorder,\%defkeytype);
1.224     www      6477:     if ($env{'form.storerules'}) {
1.560     damieng  6478:         my %newrules=();
                   6479:         my @delrules=();
                   6480:         my %triggers=();
                   6481:         foreach my $key (keys(%env)) {
1.225     albertel 6482:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6483:                 my $tempkey=$1;
                   6484:                 my $action=$env{$key};
1.226     www      6485:                 if ($action) {
1.560     damieng  6486:                     $newrules{$tempkey.'_action'}=$action;
                   6487:                     if ($action ne 'default') {
                   6488:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6489:                         $triggers{$whichparm}.=$tempkey.':';
                   6490:                     }
                   6491:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6492:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6493:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6494:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6495:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6496:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6497:                     } else {
                   6498:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6499:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6500:                     }
                   6501:                 } else {
                   6502:                     push(@delrules,$tempkey.'_action');
                   6503:                     push(@delrules,$tempkey.'_type');
                   6504:                     push(@delrules,$tempkey.'_hours');
                   6505:                     push(@delrules,$tempkey.'_min');
                   6506:                     push(@delrules,$tempkey.'_sec');
                   6507:                     push(@delrules,$tempkey.'_value');
                   6508:                 }
1.473     amueller 6509:             }
                   6510:         }
1.560     damieng  6511:         foreach my $key (keys(%allparms)) {
                   6512:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6513:         }
1.560     damieng  6514:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6515:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6516:         &resetrulescache();
1.224     www      6517:     }
1.227     www      6518:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6519:                        'hours' => 'Hours',
                   6520:                        'min' => 'Minutes',
                   6521:                        'sec' => 'Seconds',
                   6522:                        'yes' => 'Yes',
                   6523:                        'no' => 'No');
1.222     www      6524:     my @standardoptions=('','default');
                   6525:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6526:     my @dateoptions=('','default');
                   6527:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6528:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6529:         unless ($tempkey) { next; }
                   6530:         push @standardoptions,'when_setting_'.$tempkey;
                   6531:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6532:         if (&isdateparm($defkeytype{$tempkey})) {
                   6533:             push @dateoptions,'later_than_'.$tempkey;
                   6534:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6535:             push @dateoptions,'earlier_than_'.$tempkey;
                   6536:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6537:         }
1.222     www      6538:     }
1.563     damieng  6539:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6540:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6541:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6542:           &Apache::loncommon::start_data_table_header_row().
                   6543:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6544:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6545:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6546:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6547:         unless ($tempkey) { next; }
                   6548:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6549:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6550:         my $action=&rulescache($tempkey.'_action');
                   6551:         $r->print('<select name="'.$tempkey.'_action">');
                   6552:         if (&isdateparm($defkeytype{$tempkey})) {
                   6553:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6554:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6555:             $r->print("\n<option value='$dateoptions[$i]'".
                   6556:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6557:                 ">$datedisplay[$i]</option>");
                   6558:             }
                   6559:         } else {
                   6560:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6561:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6562:             $r->print("\n<option value='$standardoptions[$i]'".
                   6563:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6564:                 ">$standarddisplay[$i]</option>");
                   6565:             }
1.473     amueller 6566:         }
1.560     damieng  6567:         $r->print('</select>');
                   6568:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6569:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6570:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6571:         }
1.560     damieng  6572:         $r->print("\n</td><td>\n");
1.222     www      6573: 
1.221     www      6574:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6575:             my $days=&rulescache($tempkey.'_days');
                   6576:             my $hours=&rulescache($tempkey.'_hours');
                   6577:             my $min=&rulescache($tempkey.'_min');
                   6578:             my $sec=&rulescache($tempkey.'_sec');
                   6579:             $r->print(<<ENDINPUTDATE);
                   6580:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6581:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6582:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6583:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6584: ENDINPUTDATE
1.560     damieng  6585:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6586:                 my $yeschecked='';
                   6587:                 my $nochecked='';
                   6588:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6589:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6590: 
                   6591:             $r->print(<<ENDYESNO);
                   6592:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6593:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6594: ENDYESNO
1.221     www      6595:         } else {
1.560     damieng  6596:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6597:         }
1.318     albertel 6598:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6599:     }
1.318     albertel 6600:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6601:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6602:           &mt('Save').'" /></form>'."\n");
                   6603:     &endSettingsScreen($r);
                   6604:     $r->print(&Apache::loncommon::end_page());
1.220     www      6605:     return;
                   6606: }
1.193     albertel 6607: 
1.560     damieng  6608: ##################################################
                   6609: # PARAMETER CHANGES LOG
                   6610: ##################################################
                   6611: 
1.563     damieng  6612: # Returns some info for a parameter log entry.
                   6613: # Returned entries:
                   6614: # $realm - HTML title for the parameter level and resource
                   6615: # $section - parameter section
                   6616: # $name - parameter name
                   6617: # $part - parameter part
                   6618: # $what - $part.'.'.$name
                   6619: # $middle - resource symb ?
                   6620: # $uname - user name (same as given)
                   6621: # $udom - user domain (same as given)
                   6622: # $issection - section or group name
                   6623: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6624: #
                   6625: # @param {string} $key - parameter log key
                   6626: # @param {string} $uname - user name
                   6627: # @param {string} $udom - user domain
                   6628: # @param {boolean} $typeflag - .type log entry
                   6629: # @returns {Array}
1.290     www      6630: sub components {
1.581     raeburn  6631:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6632: 
                   6633:     if ($typeflag) {
1.560     damieng  6634:         $key=~s/\.type$//;
1.290     www      6635:     }
1.330     albertel 6636: 
                   6637:     my ($middle,$part,$name)=
1.572     damieng  6638:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6639:     my $issection;
1.330     albertel 6640: 
1.290     www      6641:     my $section=&mt('All Students');
                   6642:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6643:         $issection=$1;
                   6644:         $section=&mt('Group/Section').': '.$issection;
                   6645:         $middle=~s/^\[(.*)\]//;
1.290     www      6646:     }
                   6647:     $middle=~s/\.+$//;
                   6648:     $middle=~s/^\.+//;
1.291     www      6649:     if ($uname) {
1.560     damieng  6650:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6651:         $issection='';
1.291     www      6652:     }
1.316     albertel 6653:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6654:     my $realmdescription=&mt('all resources');
1.556     raeburn  6655:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6656:         my $mapurl = $1;
                   6657:         my $maplevel = $2;
                   6658:         my $leveltitle = &mt('Folder/Map');
                   6659:         if ($maplevel eq 'rec') {
                   6660:             $leveltitle = &mt('Recursive');
                   6661:         }
1.560     damieng  6662:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6663:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6664:             $mapurl.')</span></span>';
                   6665:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6666:     } elsif ($middle) {
                   6667:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6668:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6669:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6670:             ' in '.$map.' id: '.$id.')</span></span>';
                   6671:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6672:     }
1.291     www      6673:     my $what=$part.'.'.$name;
1.330     albertel 6674:     return ($realm,$section,$name,$part,
1.473     amueller 6675:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6676: }
1.293     www      6677: 
1.563     damieng  6678: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6679: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6680: 
1.563     damieng  6681: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6682: sub load_parameter_names {
1.583     raeburn  6683:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 6684:     while (my $configline=<$config>) {
1.560     damieng  6685:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6686:         chomp($configline);
                   6687:         my ($short,$plain)=split(/:/,$configline);
                   6688:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6689:         if ($type eq 'display') {
                   6690:             $standard_parms{$name} = $plain;
1.469     raeburn  6691:         } elsif ($type eq 'type') {
1.560     damieng  6692:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6693:         }
1.328     albertel 6694:     }
                   6695:     close($config);
                   6696:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6697:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6698:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6699: }
                   6700: 
1.563     damieng  6701: # Returns a parameter title for standard parameters, the name for others.
                   6702: #
                   6703: # @param {string} $name - parameter name
                   6704: # @returns {string}
1.292     www      6705: sub standard_parameter_names {
                   6706:     my ($name)=@_;
1.328     albertel 6707:     if (!%standard_parms) {
1.560     damieng  6708:         &load_parameter_names();
1.328     albertel 6709:     }
1.292     www      6710:     if ($standard_parms{$name}) {
1.560     damieng  6711:         return $standard_parms{$name};
1.446     bisitz   6712:     } else {
1.560     damieng  6713:         return $name;
1.292     www      6714:     }
                   6715: }
1.290     www      6716: 
1.563     damieng  6717: # Returns a parameter type for standard parameters, undef for others.
                   6718: #
                   6719: # @param {string} $name - parameter name
                   6720: # @returns {string}
1.469     raeburn  6721: sub standard_parameter_types {
                   6722:     my ($name)=@_;
                   6723:     if (!%standard_parms_types) {
                   6724:         &load_parameter_names();
                   6725:     }
                   6726:     if ($standard_parms_types{$name}) {
                   6727:         return $standard_parms_types{$name};
                   6728:     }
                   6729:     return;
                   6730: }
1.309     www      6731: 
1.563     damieng  6732: # Returns a parameter level title (not localized) from the parameter level name.
                   6733: #
                   6734: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6735: # @returns {string}
1.557     raeburn  6736: sub standard_parameter_levels {
                   6737:     my ($name)=@_;
                   6738:     my %levels = (
                   6739:                     'resourcelevel'   => 'a single resource',
                   6740:                     'maplevel'        => 'the enclosing map/folder', 
                   6741:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6742:                     'courselevel'     => 'the general (course) level',
                   6743:                  );
                   6744:     if ($levels{$name}) {
                   6745:         return $levels{$name};
                   6746:     }
                   6747:     return;
                   6748: }
                   6749: 
1.560     damieng  6750: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6751: #
                   6752: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6753: sub parm_change_log {
1.568     raeburn  6754:     my ($r,$parm_permission)=@_;
1.531     raeburn  6755:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6756:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6757:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6758:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6759:     text=>"Parameter Change Log"});
1.522     raeburn  6760:     my $js = '<script type="text/javascript">'."\n".
                   6761:              '// <![CDATA['."\n".
                   6762:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6763:              '// ]]>'."\n".
                   6764:              '</script>'."\n";
                   6765:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6766:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6767:     &startSettingsScreen($r,'parmset',$crstype);
                   6768:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6769: 
1.301     www      6770:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6771: 
1.522     raeburn  6772:     $r->print('<div class="LC_left_float">'.
                   6773:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6774:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6775:                      method="post" name="parameterlog">');
1.446     bisitz   6776: 
1.311     albertel 6777:     my %saveable_parameters = ('show' => 'scalar',);
                   6778:     &Apache::loncommon::store_course_settings('parameter_log',
                   6779:                                               \%saveable_parameters);
                   6780:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6781:                                                 \%saveable_parameters);
1.522     raeburn  6782:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6783:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6784:               '</form></fieldset></div><br clear="all" />');
1.301     www      6785: 
1.568     raeburn  6786:     my $readonly = 1;
                   6787:     if ($parm_permission->{'edit'}) {
                   6788:         undef($readonly);
                   6789:     }
1.531     raeburn  6790:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6791:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6792:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6793:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6794:     unless ($readonly) {
                   6795:         $r->print('<th>'.&mt('Announce').'</th>');
                   6796:     }
                   6797:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6798:     my $shown=0;
1.349     www      6799:     my $folder='';
                   6800:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6801:         my $last='';
                   6802:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6803:                 &GDBM_READER(),0640)) {
                   6804:             $last=$hash{'last_known'};
                   6805:             untie(%hash);
                   6806:         }
                   6807:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6808:     }
                   6809:     foreach my $id (sort {
                   6810:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6811:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6812:                 }
                   6813:                 my $aid = (split('00000',$a))[-1];
                   6814:                 my $bid = (split('00000',$b))[-1];
                   6815:                 return $bid<=>$aid;
1.473     amueller 6816:             } (keys(%parmlog))) {
1.294     www      6817:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6818:         my $count = 0;
                   6819:         my $time =
                   6820:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6821:         my $plainname =
                   6822:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6823:                         $parmlog{$id}{'exe_udom'});
                   6824:         my $about_me_link =
                   6825:             &Apache::loncommon::aboutmewrapper($plainname,
                   6826:                             $parmlog{$id}{'exe_uname'},
                   6827:                             $parmlog{$id}{'exe_udom'});
                   6828:         my $send_msg_link='';
1.568     raeburn  6829:         if ((!$readonly) && 
                   6830:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6831:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6832:             $send_msg_link ='<br />'.
                   6833:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6834:                             $parmlog{$id}{'exe_uname'},
                   6835:                             $parmlog{$id}{'exe_udom'});
                   6836:         }
                   6837:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6838:         my $makenewrow=0;
                   6839:         my %istype=();
                   6840:         my $output;
                   6841:         foreach my $changed (reverse(sort(@changes))) {
                   6842:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6843:             my $typeflag = ($changed =~/\.type$/ &&
                   6844:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6845:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581     raeburn  6846:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6847:             if ($env{'request.course.sec'} ne '') {
                   6848:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6849:                 if ($uname ne '') {
                   6850:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6851:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6852:                 }
                   6853:             }
                   6854:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6855:                 if ($folder) {
                   6856:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6857:                 }
                   6858:             }
                   6859:             if ($typeflag) {
                   6860:                 $istype{$parmname}=$value;
                   6861:                 if (!$env{'form.includetypes'}) { next; }
                   6862:             }
                   6863:             $count++;
                   6864:             if ($makenewrow) {
                   6865:                 $output .= $row_start;
                   6866:             } else {
                   6867:                 $makenewrow=1;
                   6868:             }
1.470     raeburn  6869:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6870:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6871:                 &mt($parmitem).'</td><td>'.
                   6872:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6873:             my $stillactive=0;
                   6874:             if ($parmlog{$id}{'delflag'}) {
                   6875:                 $output .= &mt('Deleted');
                   6876:             } else {
                   6877:                 if ($typeflag) {
1.470     raeburn  6878:                     my $parmitem = &standard_parameter_names($value); 
                   6879:                     $parmitem = &mt($parmitem);
1.560     damieng  6880:                     $output .= &mt('Type: [_1]',$parmitem);
                   6881:                 } else {
1.584     raeburn  6882:                     my $toolsymb;
                   6883:                     if ($middle =~ /ext\.tool$/) {
                   6884:                         $toolsymb = $middle;
                   6885:                     }
1.560     damieng  6886:                     my ($level,@all)=&parmval_by_symb($what,$middle,
1.584     raeburn  6887:                         &Apache::lonnet::metadata($middle,$what,$toolsymb),
1.560     damieng  6888:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6889:                     my $showvalue = $value;
                   6890:                     if ($istype{$parmname} eq '') {
                   6891:                         my $type = &standard_parameter_types($parmname);
                   6892:                         if ($type ne '') {
                   6893:                             if (&isdateparm($type)) {
                   6894:                                 $showvalue =
                   6895:                                     &Apache::lonlocal::locallocaltime($value);
                   6896:                             }
                   6897:                         }
                   6898:                     } else {
1.560     damieng  6899:                         if (&isdateparm($istype{$parmname})) {
                   6900:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6901:                         }
1.469     raeburn  6902:                     }
                   6903:                     $output .= $showvalue;
1.560     damieng  6904:                     if ($value ne $all[$level]) {
                   6905:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6906:                     } else {
                   6907:                         $stillactive=1;
                   6908:                     }
                   6909:                 }
1.473     amueller 6910:             }
1.568     raeburn  6911:             $output .= '</td>';
                   6912: 
                   6913:             unless ($readonly) { 
                   6914:                 $output .= '<td>';
                   6915:                 if ($stillactive) {
                   6916:                     my $parmitem = &standard_parameter_names($parmname);
                   6917:                     $parmitem = &mt($parmitem);
                   6918:                     my $title=&mt('Changed [_1]',$parmitem);
                   6919:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   6920:                         $parmitem,$realmdescription,
                   6921:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   6922:                     if (($uname) && ($udom)) {
                   6923:                         $output .=
                   6924:                         &Apache::loncommon::messagewrapper('Notify User',
                   6925:                                                            $uname,$udom,$title,
                   6926:                                                            $description);
                   6927:                     } else {
                   6928:                         $output .=
                   6929:                             &Apache::lonrss::course_blog_link($id,$title,
                   6930:                                                               $description);
                   6931:                     }
1.560     damieng  6932:                 }
1.568     raeburn  6933:                 $output .= '</td>';
1.560     damieng  6934:             }
1.568     raeburn  6935:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 6936:         }
1.560     damieng  6937:         if ($env{'form.displayfilter'} eq 'containing') {
                   6938:             my $wholeentry=$about_me_link.':'.
                   6939:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6940:             $output;
                   6941:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6942:         }
1.349     www      6943:         if ($count) {
1.560     damieng  6944:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6945:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6946:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6947:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6948:             $send_msg_link.'</td>'.$output);
                   6949:             $shown++;
                   6950:         }
                   6951:         if (!($env{'form.show'} eq &mt('all')
                   6952:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6953:     }
1.301     www      6954:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6955:     &endSettingsScreen($r);
1.284     www      6956:     $r->print(&Apache::loncommon::end_page());
                   6957: }
                   6958: 
1.560     damieng  6959: ##################################################
                   6960: # MISC !
                   6961: ##################################################
                   6962: 
1.563     damieng  6963: # Stores slot information.
1.560     damieng  6964: # Used by table UI
1.563     damieng  6965: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6966: #
                   6967: # @param {string} $slot_name - slot name
                   6968: # @param {string} $cdom - course domain
                   6969: # @param {string} $cnum - course number
                   6970: # @param {string} $symb - resource symb
                   6971: # @param {string} $uname - user name
                   6972: # @param {string} $udom - user domain
                   6973: # @returns {string} - 'ok' or error name
1.437     raeburn  6974: sub update_slots {
                   6975:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6976:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6977:     if (!keys(%slot)) {
                   6978:         return 'error: slot does not exist';
                   6979:     }
                   6980:     my $max=$slot{'maxspace'};
                   6981:     if (!defined($max)) { $max=99999; }
                   6982: 
                   6983:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6984:                                        "^$slot_name\0");
                   6985:     my ($tmp)=%consumed;
                   6986:     if ($tmp=~/^error: 2 / ) {
                   6987:         return 'error: unable to determine current slot status';
                   6988:     }
                   6989:     my $last=0;
                   6990:     foreach my $key (keys(%consumed)) {
                   6991:         my $num=(split('\0',$key))[1];
                   6992:         if ($num > $last) { $last=$num; }
                   6993:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6994:             return 'ok';
                   6995:         }
                   6996:     }
                   6997: 
                   6998:     if (scalar(keys(%consumed)) >= $max) {
                   6999:         return 'error: no space left in slot';
                   7000:     }
                   7001:     my $wanted=$last+1;
                   7002: 
                   7003:     my %reservation=('name'      => $uname.':'.$udom,
                   7004:                      'timestamp' => time,
                   7005:                      'symb'      => $symb);
                   7006: 
                   7007:     my $success=&Apache::lonnet::newput('slot_reservations',
                   7008:                                         {"$slot_name\0$wanted" =>
                   7009:                                              \%reservation},
                   7010:                                         $cdom, $cnum);
1.438     raeburn  7011:     if ($success eq 'ok') {
                   7012:         my %storehash = (
                   7013:                           symb    => $symb,
                   7014:                           slot    => $slot_name,
                   7015:                           action  => 'reserve',
                   7016:                           context => 'parameter',
                   7017:                         );
1.526     raeburn  7018:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7019:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  7020: 
1.526     raeburn  7021:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7022:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  7023:     }
1.437     raeburn  7024:     return $success;
                   7025: }
                   7026: 
1.563     damieng  7027: # Deletes a slot reservation.
1.560     damieng  7028: # Used by table UI
1.563     damieng  7029: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   7030: #
                   7031: # @param {string} $slot_name - slot name
                   7032: # @param {string} $cdom - course domain
                   7033: # @param {string} $cnum - course number
                   7034: # @param {string} $uname - user name
                   7035: # @param {string} $udom - user domain
                   7036: # @param {string} $symb - resource symb
                   7037: # @returns {string} - 'ok' or error name
1.437     raeburn  7038: sub delete_slots {
                   7039:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   7040:     my $delresult;
                   7041:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   7042:                                          $cnum, "^$slot_name\0");
                   7043:     if (&Apache::lonnet::error(%consumed)) {
                   7044:         return 'error: unable to determine current slot status';
                   7045:     }
                   7046:     my ($tmp)=%consumed;
                   7047:     if ($tmp=~/^error: 2 /) {
                   7048:         return 'error: unable to determine current slot status';
                   7049:     }
                   7050:     foreach my $key (keys(%consumed)) {
                   7051:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   7052:             my $num=(split('\0',$key))[1];
                   7053:             my $entry = $slot_name.'\0'.$num;
                   7054:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   7055:                                               $cdom,$cnum);
                   7056:             if ($delresult eq 'ok') {
                   7057:                 my %storehash = (
                   7058:                                   symb    => $symb,
                   7059:                                   slot    => $slot_name,
                   7060:                                   action  => 'release',
                   7061:                                   context => 'parameter',
                   7062:                                 );
1.526     raeburn  7063:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  7064:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  7065:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  7066:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  7067:             }
                   7068:         }
                   7069:     }
                   7070:     return $delresult;
                   7071: }
                   7072: 
1.563     damieng  7073: # Returns true if there is a current course.
1.560     damieng  7074: # Used by handler
1.563     damieng  7075: #
                   7076: # @returns {boolean}
1.355     albertel 7077: sub check_for_course_info {
                   7078:     my $navmap = Apache::lonnavmaps::navmap->new();
                   7079:     return 1 if ($navmap);
                   7080:     return 0;
                   7081: }
                   7082: 
1.563     damieng  7083: # Returns the current course host and host LON-CAPA version.
                   7084: #
                   7085: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  7086: sub parameter_release_vars { 
1.504     raeburn  7087:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   7088:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   7089:    my $chostname = &Apache::lonnet::hostname($chome);
                   7090:    my ($cmajor,$cminor) = 
                   7091:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   7092:    return ($chostname,$cmajor,$cminor);
                   7093: }
                   7094: 
1.563     damieng  7095: # Checks if the course host version can handle a parameter required version,
                   7096: # and if it does, stores the release needed for the course.
                   7097: #
                   7098: # @param {string} $name - parameter name
                   7099: # @param {string} $value - parameter value
                   7100: # @param {string} $valmatch - name of the test used for checking the value
                   7101: # @param {string} $namematch - name of the test used for checking the name
                   7102: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   7103: # @param {integer} $cmajor - course major version number
                   7104: # @param {integer} $cminor - course minor version number
                   7105: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  7106: sub parameter_releasecheck {
1.557     raeburn  7107:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  7108:     my $needsnewer;
                   7109:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   7110:     if (($cmajor < $needsmajor) || 
                   7111:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   7112:         $needsnewer = 1;
1.557     raeburn  7113:     } elsif ($name) {
                   7114:         if ($valmatch) {
                   7115:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   7116:         } elsif ($value) { 
                   7117:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   7118:         }
                   7119:     } elsif ($namematch) {
                   7120:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  7121:     }
                   7122:     return $needsnewer;
                   7123: }
                   7124: 
1.568     raeburn  7125: sub get_permission {
                   7126:     my %permission;
                   7127:     my $allowed = 0;
                   7128:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   7129:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   7130:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   7131:                   $env{'request.course.sec'}))) {
                   7132:         %permission= (
                   7133:                        'edit'               => 1,
                   7134:                        'set'                => 1,
                   7135:                        'setoverview'        => 1,
                   7136:                        'addmetadata'        => 1,
                   7137:                        'ordermetadata'      => 1,
                   7138:                        'setrestrictmeta'    => 1,
                   7139:                        'newoverview'        => 1,
                   7140:                        'setdefaults'        => 1,
                   7141:                        'settable'           => 1,
                   7142:                        'parameterchangelog' => 1,
                   7143:                        'cleanparameters'    => 1,
                   7144:                        'dateshift1'         => 1,
                   7145:                        'dateshift2'         => 1,
                   7146:                        'helper'             => 1,
                   7147:          );
                   7148:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   7149:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   7150:                   $env{'request.course.sec'}))) {
                   7151:         %permission = (
                   7152:                        'set'                => 1,
                   7153:                        'settable'           => 1,
                   7154:                        'newoverview'        => 1,
                   7155:                        'setoverview'        => 1,
                   7156:                        'parameterchangelog' => 1,
                   7157:                       );
                   7158:     }
                   7159:     foreach my $perm (values(%permission)) {
                   7160:         if ($perm) { $allowed=1; last; }
                   7161:     }
                   7162:     return (\%permission,$allowed);
                   7163: }
                   7164: 
1.560     damieng  7165: ##################################################
                   7166: # HANDLER
                   7167: ##################################################
                   7168: 
                   7169: # Main handler for lonparmset.
                   7170: # Sub called based on request parameters action and command:
                   7171: # no command or action: print_main_menu
                   7172: # command 'set': assessparms (direct access to table mode for a resource)
                   7173: #                (this can also be accessed simply with the symb parameter)
                   7174: # action 'setoverview': overview (display all existing parameter settings)
                   7175: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   7176: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   7177: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   7178: # action 'newoverview': newoverview (overview mode)
                   7179: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   7180: # action 'settable': assessparms (table mode)
                   7181: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   7182: #                              blog postings, user notification changes)
                   7183: # action 'cleanparameters': clean_parameters (unused)
                   7184: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   7185: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      7186: sub handler {
1.43      albertel 7187:     my $r=shift;
1.30      www      7188: 
1.376     albertel 7189:     &reset_caches();
                   7190: 
1.414     droeschl 7191:     &Apache::loncommon::content_type($r,'text/html');
                   7192:     $r->send_http_header;
                   7193:     return OK if $r->header_only;
                   7194: 
1.193     albertel 7195:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 7196:                         ['action','state',
1.205     www      7197:                                              'pres_marker',
                   7198:                                              'pres_value',
1.206     www      7199:                                              'pres_type',
1.506     www      7200:                                              'filter','part',
1.390     www      7201:                                              'udom','uname','symb','serial','timebase']);
1.131     www      7202: 
1.83      bowersj2 7203: 
1.193     albertel 7204:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 7205:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      7206:                         text=>"Content and Problem Settings",
1.473     amueller 7207:                         faq=>10,
                   7208:                         bug=>'Instructor Interface',
1.442     droeschl 7209:                                             help =>
                   7210:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      7211: 
1.30      www      7212: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  7213:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 7214:     my $exists = &check_for_course_info();
                   7215: 
1.568     raeburn  7216:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 7217:         #
                   7218:         # Main switch on form.action and form.state, as appropriate
                   7219:         #
                   7220:         # Check first if coming from someone else headed directly for
                   7221:         #  the table mode
1.568     raeburn  7222:         if (($parm_permission->{'set'}) && 
                   7223:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   7224:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   7225:             &assessparms($r,$parm_permission);
1.193     albertel 7226:         } elsif (! exists($env{'form.action'})) {
                   7227:             &print_main_menu($r,$parm_permission);
1.568     raeburn  7228:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   7229:             &print_main_menu($r,$parm_permission);
1.414     droeschl 7230:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  7231:             &overview($r,$parm_permission);
1.560     damieng  7232:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   7233:             &addmetafield($r);
                   7234:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   7235:             &order_meta_fields($r);
1.414     droeschl 7236:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  7237:             &setrestrictmeta($r);
1.414     droeschl 7238:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  7239:             &newoverview($r,$parm_permission);
1.414     droeschl 7240:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  7241:             &defaultsetter($r);
                   7242:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  7243:             &assessparms($r,$parm_permission);
1.414     droeschl 7244:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  7245:             &parm_change_log($r,$parm_permission);
1.414     droeschl 7246:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  7247:             &clean_parameters($r);
1.414     droeschl 7248:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      7249:             &date_shift_one($r);
1.414     droeschl 7250:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      7251:             &date_shift_two($r);
1.446     bisitz   7252:         }
1.43      albertel 7253:     } else {
1.1       www      7254: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  7255:         if ($exists) {
                   7256:             $env{'user.error.msg'}=
                   7257:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   7258:         } else {
                   7259:             $env{'user.error.msg'}=
                   7260:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   7261:         }
                   7262:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 7263:     }
1.376     albertel 7264:     &reset_caches();
                   7265: 
1.43      albertel 7266:     return OK;
1.1       www      7267: }
                   7268: 
                   7269: 1;
                   7270: __END__
                   7271: 
                   7272: 

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