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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.581   ! raeburn     4: # $Id: lonparmset.pm,v 1.580 2017/07/15 02:49:10 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.578     raeburn  1068: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive. 
1.5       www      1069: sub plink {
1.578     raeburn  1070:     my ($type,$dis,$value,$marker,$return,$call,$recursive)=@_;
1.23      www      1071:     my $winvalue=$value;
                   1072:     unless ($winvalue) {
1.560     damieng  1073:         if (&isdateparm($type)) {
1.190     albertel 1074:             $winvalue=$env{'form.recent_'.$type};
1.23      www      1075:         } else {
1.190     albertel 1076:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www      1077:         }
                   1078:     }
1.229     www      1079:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                   1080:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   1081:     unless (defined($winvalue)) { $winvalue=$val; }
1.554     raeburn  1082:     my $valout = &valout($value,$type,$parmname,1);
1.429     raeburn  1083:     my $unencmarker = $marker;
1.378     albertel 1084:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.473     amueller 1085:               \$hour, \$min, \$sec) {
1.560     damieng  1086:         $$item = &HTML::Entities::encode($$item,'"<>&');
                   1087:         $$item =~ s/\'/\\\'/g;
1.378     albertel 1088:     }
1.429     raeburn  1089:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller 1090:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                   1091:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
1.578     raeburn  1092:         $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
                   1093:                                               &mt('recursive').'</td></tr>' : '').'</table>';
                   1094: 
1.5       www      1095: }
                   1096: 
1.561     damieng  1097: # Javascript for table mode.
1.280     albertel 1098: sub page_js {
                   1099: 
1.81      www      1100:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew  1101:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel 1102: 
                   1103:     return(<<ENDJS);
                   1104: <script type="text/javascript">
1.454     bisitz   1105: // <![CDATA[
1.44      albertel 1106: 
1.88      matthew  1107:     $pjump_def
1.44      albertel 1108: 
                   1109:     function psub() {
                   1110:         if (document.parmform.pres_marker.value!='') {
                   1111:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                   1112:             var typedef=new Array();
                   1113:             typedef=document.parmform.pres_type.value.split('_');
1.562     damieng  1114:             if (document.parmform.pres_type.value!='') {
                   1115:                 if (typedef[0]=='date') {
                   1116:                     eval('document.parmform.recent_'+
                   1117:                         document.parmform.pres_type.value+
                   1118:                         '.value=document.parmform.pres_value.value;');
                   1119:                 } else {
                   1120:                     eval('document.parmform.recent_'+typedef[0]+
                   1121:                         '.value=document.parmform.pres_value.value;');
                   1122:                 }
1.44      albertel 1123:             }
                   1124:             document.parmform.submit();
                   1125:         } else {
                   1126:             document.parmform.pres_value.value='';
                   1127:             document.parmform.pres_marker.value='';
                   1128:         }
                   1129:     }
                   1130: 
1.57      albertel 1131:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                   1132:         var options = "width=" + w + ",height=" + h + ",";
                   1133:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                   1134:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                   1135:         var newWin = window.open(url, wdwName, options);
                   1136:         newWin.focus();
                   1137:     }
1.523     raeburn  1138: 
1.454     bisitz   1139: // ]]>
1.523     raeburn  1140: 
1.44      albertel 1141: </script>
1.81      www      1142: $selscript
1.280     albertel 1143: ENDJS
                   1144: 
                   1145: }
1.507     www      1146: 
1.561     damieng  1147: # Javascript to show or hide the map selection (function showHide_courseContent),
                   1148: # for table and overview modes.
1.523     raeburn  1149: sub showhide_js {
                   1150:     return <<"COURSECONTENTSCRIPT";
                   1151: 
                   1152: function showHide_courseContent() {
                   1153:     var parmlevValue=document.getElementById("parmlev").value;
                   1154:     if (parmlevValue == 'general') {
                   1155:         document.getElementById('mapmenu').style.display="none";
                   1156:     } else {
                   1157:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                   1158:             document.getElementById('mapmenu').style.display ="";
                   1159:         } else {
                   1160:             document.getElementById('mapmenu').style.display="none";
                   1161:         }
                   1162:     }
                   1163:     return;
                   1164: }
                   1165: 
                   1166: COURSECONTENTSCRIPT
                   1167: }
                   1168: 
1.561     damieng  1169: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549     raeburn  1170: sub toggleparmtextbox_js {
                   1171:     return <<"ENDSCRIPT";
                   1172: 
                   1173: if (!document.getElementsByClassName) {
                   1174:     function getElementsByClassName(node, classname) {
                   1175:         var a = [];
                   1176:         var re = new RegExp('(^| )'+classname+'( |$)');
                   1177:         var els = node.getElementsByTagName("*");
                   1178:         for(var i=0,j=els.length; i<j; i++)
                   1179:             if(re.test(els[i].className))a.push(els[i]);
                   1180:         return a;
                   1181:     }
                   1182: }
                   1183: 
                   1184: function showHideLenient() {
                   1185:     var lenients;
                   1186:     var setRegExp = /^set_/;
                   1187:     if (document.getElementsByClassName) {
                   1188:         lenients = document.getElementsByClassName('LC_lenient_radio');
                   1189:     } else {
                   1190:         lenients = getElementsByClassName(document.body,'LC_lenient_radio');
                   1191:     }
                   1192:     if (lenients != 'undefined') {
                   1193:         for (var i=0; i<lenients.length; i++) {
                   1194:             if (lenients[i].checked) {
                   1195:                 if (lenients[i].value == 'weighted') {
                   1196:                     if (setRegExp.test(lenients[i].name)) {
                   1197:                         var identifier = lenients[i].name.replace(setRegExp,'');
                   1198:                         toggleParmTextbox(document.parmform,identifier);
                   1199:                     }
                   1200:                 }
                   1201:             }
                   1202:         }
                   1203:     }
                   1204:     return;
                   1205: }
                   1206: 
                   1207: function toggleParmTextbox(form,key) {
                   1208:     var divfortext = document.getElementById('LC_parmtext_'+key);
                   1209:     if (divfortext) {
                   1210:         var caller = form.elements['set_'+key];
                   1211:         if (caller.length) {
                   1212:             for (i=0; i<caller.length; i++) {
                   1213:                 if (caller[i].checked) {
                   1214:                     if (caller[i].value == 'weighted') {
                   1215:                         divfortext.style.display = 'inline';
                   1216:                     } else {
                   1217:                         divfortext.style.display = 'none';
                   1218:                     }
                   1219:                 }
                   1220:             }
                   1221:         }
                   1222:     }
                   1223:     return;
                   1224: }
                   1225: 
                   1226: ENDSCRIPT
                   1227: }
                   1228: 
1.561     damieng  1229: # Javascript function validateParms, for overview mode
1.549     raeburn  1230: sub validateparms_js {
                   1231:     return <<'ENDSCRIPT';
                   1232: 
                   1233: function validateParms() {
                   1234:     var textRegExp = /^settext_/;
                   1235:     var tailLenient = /\.lenient$/;
                   1236:     var patternRelWeight = /^\-?[\d.]+$/;
                   1237:     var patternLenientStd = /^(yes|no|default)$/;
                   1238:     var ipallowRegExp = /^setipallow_/;
                   1239:     var ipdenyRegExp = /^setipdeny_/; 
                   1240:     var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
                   1241:     if ((document.parmform.elements.length != 'undefined')  && (document.parmform.elements.length) != 'null') {
                   1242:         if (document.parmform.elements.length) {
                   1243:             for (i=0; i<document.parmform.elements.length; i++) {
                   1244:                 var name=document.parmform.elements[i].name;
                   1245:                 if (textRegExp.test(name)) { 
                   1246:                     var identifier = name.replace(textRegExp,'');
                   1247:                     if (tailLenient.test(identifier)) {
                   1248:                         if (document.parmform.elements['set_'+identifier].length) {
                   1249:                             for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
                   1250:                                 if (document.parmform.elements['set_'+identifier][j].checked) {
                   1251:                                     if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
                   1252:                                         var relweight = document.parmform.elements[i].value;
                   1253:                                         relweight = relweight.replace(/^\s+|\s+$/g,'');
                   1254:                                         if (!patternRelWeight.test(relweight)) {
                   1255:                                             relweight = '0.0';
                   1256:                                         }
                   1257:                                         if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
                   1258:                                             document.parmform.elements['set_'+identifier][j].value = relweight;
                   1259:                                         } else {
                   1260:                                             document.parmform.elements['set_'+identifier][j].value += ','+relweight;
                   1261:                                         }
                   1262:                                     }
                   1263:                                     break;
                   1264:                                 }
                   1265:                             }
                   1266:                         }
                   1267:                     }
                   1268:                 } else {
                   1269:                     if (ipallowRegExp.test(name)) {
                   1270:                         var identifier = name.replace(ipallowRegExp,'');
                   1271:                         var possallow = document.parmform.elements[i].value;
                   1272:                         possallow = possallow.replace(/^\s+|\s+$/g,'');
                   1273:                         if (patternIP.test(possallow)) {
                   1274:                             if (document.parmform.elements['set_'+identifier].value) {
                   1275:                                 possallow = ','+possallow;
                   1276:                             }
                   1277:                             document.parmform.elements['set_'+identifier].value += possallow; 
                   1278:                         }
                   1279:                     } else {
                   1280:                         if (ipdenyRegExp.test(name)) {
                   1281:                             var identifier = name.replace(ipdenyRegExp,'');
                   1282:                             var possdeny = document.parmform.elements[i].value;
                   1283:                             possdeny = possdeny.replace(/^\s+|\s+$/g,'');
                   1284:                             if (patternIP.test(possdeny)) {
                   1285:                                 possdeny = '!'+possdeny;
                   1286:                                 if (document.parmform.elements['set_'+identifier].value) {
                   1287:                                     possdeny = ','+possdeny;
                   1288:                                 }
                   1289:                                 document.parmform.elements['set_'+identifier].value += possdeny;
                   1290:                             }
                   1291:                         }
                   1292:                     }
                   1293:                 }
                   1294:             }
                   1295:         }
                   1296:     }
                   1297:     return true;
                   1298: }
                   1299: 
                   1300: ENDSCRIPT
                   1301: }
                   1302: 
1.561     damieng  1303: # Javascript initialization, for overview mode
1.549     raeburn  1304: sub ipacc_boxes_js  {
                   1305:     my $remove = &mt('Remove');
                   1306:     return <<"END";
                   1307: \$(document).ready(function() {
                   1308:     var wrapper         = \$(".LC_string_ipacc_wrap");
                   1309:     var add_button      = \$(".LC_add_ipacc_button");
                   1310:     var ipaccRegExp     = /^LC_string_ipacc_/;
                   1311: 
                   1312:     \$(add_button).click(function(e){
                   1313:         e.preventDefault();
                   1314:         var identifier = \$(this).closest("div").attr("id");
                   1315:         identifier = identifier.replace(ipaccRegExp,'');
1.551     raeburn  1316:         \$(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  1317:     });
                   1318: 
                   1319:     \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
                   1320:         e.preventDefault(); \$(this).closest("div").remove();
                   1321:     })
                   1322: });
                   1323: 
                   1324: 
                   1325: END
                   1326: }
                   1327: 
1.561     damieng  1328: # Javascript function toggleSecret, for overview mode.
1.558     raeburn  1329: sub done_proctor_js {
                   1330:     return <<"END";
                   1331: function toggleSecret(form,radio,key) {
                   1332:     var radios = form[radio+key];
                   1333:     if (radios.length) {
                   1334:         for (var i=0; i<radios.length; i++) {
                   1335:             if (radios[i].checked) {
                   1336:                 if (radios[i].value == '_done_proctor') {
                   1337:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1338:                         document.getElementById('done_'+key+'_proctorkey').type='text';
                   1339:                     }
                   1340:                 } else {
                   1341:                     if (document.getElementById('done_'+key+'_proctorkey')) {
                   1342:                         document.getElementById('done_'+key+'_proctorkey').type='hidden';
                   1343:                         document.getElementById('done_'+key+'_proctorkey').value='';
                   1344:                     }
                   1345:                 }
                   1346:             }
                   1347:         }
                   1348:     }
                   1349: }
                   1350: END
                   1351: 
                   1352: }
                   1353: 
1.561     damieng  1354: # Prints HTML page start for table mode.
                   1355: # @param {Apache2::RequestRec} $r - the Apache request
                   1356: # @param {string} $psymb - resource symb
                   1357: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280     albertel 1358: sub startpage {
1.531     raeburn  1359:     my ($r,$psymb,$crstype) = @_;
1.281     albertel 1360: 
1.515     raeburn  1361:     my %loaditems = (
                   1362:                       'onload'   => "group_or_section('cgroup')",
                   1363:                     );
                   1364:     if (!$psymb) {
1.523     raeburn  1365:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn  1366:     }
1.280     albertel 1367: 
1.560     damieng  1368:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   1369:             (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   1370:         &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                   1371:             text=>"Problem Parameters"});
1.414     droeschl 1372:     } else {
1.560     damieng  1373:         &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   1374:             text=>"Table Mode",
                   1375:             help => 'Course_Setting_Parameters'});
1.414     droeschl 1376:     }
1.523     raeburn  1377:     my $js = &page_js().'
                   1378: <script type="text/javascript">
                   1379: // <![CDATA[
                   1380: '.
                   1381:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                   1382: // ]]>
                   1383: </script>
                   1384: ';
1.446     bisitz   1385:     my $start_page =
1.523     raeburn  1386:         &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
                   1387:                                        {'add_entries' => \%loaditems,});
1.446     bisitz   1388:     my $breadcrumbs =
1.473     amueller 1389:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www      1390:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                   1391:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www      1392:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  1393:     &startSettingsScreen($r,'parmset',$crstype);
1.280     albertel 1394:     $r->print(<<ENDHEAD);
1.193     albertel 1395: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz   1396: <input type="hidden" value="" name="pres_value" />
                   1397: <input type="hidden" value="" name="pres_type" />
                   1398: <input type="hidden" value="" name="pres_marker" />
                   1399: <input type="hidden" value="1" name="prevvisit" />
1.506     www      1400: <input type="hidden" value="$escfilter" name="filter" />
                   1401: <input type="hidden" value="$escpart" name="part" />
1.44      albertel 1402: ENDHEAD
                   1403: }
                   1404: 
1.209     www      1405: 
1.561     damieng  1406: # Prints a row for table mode (except for the tr start).
                   1407: # Every time a hash reference is passed, a single entry is used, so print_row
                   1408: # could just use these values, but why make it simple when it can be complicated ?
                   1409: #
                   1410: # @param {Apache2::RequestRec} $r - the Apache request
                   1411: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
                   1412: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
                   1413: # @param {hash reference} $name - parameter key -> parameter name
1.566     damieng  1414: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561     damieng  1415: # @param {string} $rid - resource id
                   1416: # @param {hash reference} $default - parameter key -> resource parameter default value
                   1417: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
                   1418: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1419: # @param {string} $defbgone - user level and other levels background color
                   1420: # @param {string} $defbgtwo - section level background color, also used for part number
                   1421: # @param {string} $defbgthree - group level background color
                   1422: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   1423: # @param {string} $uname - user name
                   1424: # @param {string} $udom - user domain
                   1425: # @param {string} $csec - section name
                   1426: # @param {string} $cgroup - group name
                   1427: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1428: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1429: # @param {boolean} $readonly - true if no editing allowed. 
1.44      albertel 1430: sub print_row {
1.201     www      1431:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568     raeburn  1432:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
                   1433:     $readonly)=@_;
1.275     raeburn  1434:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1435:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1436:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.553     raeburn  1437: 
1.560     damieng  1438:     # get the values for the parameter in cascading order
                   1439:     # empty levels will remain empty
1.44      albertel 1440:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller 1441:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1442:     # get the type for the parameters
                   1443:     # problem: these may not be set for all levels
1.66      www      1444:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn  1445:                                           $$name{$which}.'.type',$rid,
1.473     amueller 1446:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560     damieng  1447:     # cascade down manually
1.182     albertel 1448:     my $cascadetype=$$defaulttype{$which};
1.556     raeburn  1449:     for (my $i=18;$i>0;$i--) {
1.560     damieng  1450:         if ($typeoutpar[$i]) {
1.66      www      1451:             $cascadetype=$typeoutpar[$i];
1.560     damieng  1452:         } else {
1.66      www      1453:             $typeoutpar[$i]=$cascadetype;
                   1454:         }
                   1455:     }
1.57      albertel 1456:     my $parm=$$display{$which};
                   1457: 
1.203     www      1458:     if ($parmlev eq 'full') {
1.419     bisitz   1459:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www      1460:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn  1461:     } else {
1.57      albertel 1462:         $parm=~s|\[.*\]\s||g;
                   1463:     }
1.231     www      1464:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                   1465:     if ($automatic) {
1.560     damieng  1466:         $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www      1467:     }
1.427     bisitz   1468:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz   1469: 
1.44      albertel 1470:     my $thismarker=$which;
                   1471:     $thismarker=~s/^parameter\_//;
                   1472:     my $mprefix=$rid.'&'.$thismarker.'&';
1.554     raeburn  1473:     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$thismarker);
1.578     raeburn  1474:     my ($othergrp,$grp_parm,$controlgrp,$effparm_rec);
                   1475:     if ($result == 17 || $result == 11 || $result == 7 || $result == 3) {
                   1476:         $effparm_rec = 1;
                   1477:     }
1.57      albertel 1478:     if ($parmlev eq 'general') {
                   1479:         if ($uname) {
1.568     raeburn  1480:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.269     raeburn  1481:         } elsif ($cgroup) {
1.568     raeburn  1482:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57      albertel 1483:         } elsif ($csec) {
1.568     raeburn  1484:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1485:         } else {
1.568     raeburn  1486:             &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1487:         }
                   1488:     } elsif ($parmlev eq 'map') {
                   1489:         if ($uname) {
1.578     raeburn  1490:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1); 
1.269     raeburn  1491:         } elsif ($cgroup) {
1.578     raeburn  1492:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1);
1.57      albertel 1493:         } elsif ($csec) {
1.578     raeburn  1494:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.57      albertel 1495:         } else {
1.578     raeburn  1496:             &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.57      albertel 1497:         }
                   1498:     } else {
1.275     raeburn  1499:         if ($uname) {
                   1500:             if (@{$usersgroups} > 1) {
                   1501:                 my ($coursereply,$grp_parm,$controlgrp);
                   1502:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
1.580     raeburn  1503:                     &check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1504:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.556     raeburn  1505:                 if ($coursereply && $result > 4) {
1.275     raeburn  1506:                     if (defined($controlgrp)) {
                   1507:                         if ($cgroup ne $controlgrp) {
                   1508:                             $effective_parm = $grp_parm;
                   1509:                             $result = 0;
                   1510:                         }
                   1511:                     }
                   1512:                 }
                   1513:             }
                   1514:         }
1.57      albertel 1515: 
1.568     raeburn  1516:         &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578     raeburn  1517:         &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568     raeburn  1518:         &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
                   1519:         &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
                   1520:         &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548     raeburn  1521: 
                   1522:         if ($csec) {
1.568     raeburn  1523:             &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578     raeburn  1524:             &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568     raeburn  1525:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548     raeburn  1526:         }
1.269     raeburn  1527: 
                   1528:         if ($cgroup) {
1.569     raeburn  1529:             &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
1.578     raeburn  1530:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1);
1.569     raeburn  1531:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly);
1.269     raeburn  1532:         }
1.446     bisitz   1533: 
1.548     raeburn  1534:         if ($uname) {
1.275     raeburn  1535:             if ($othergrp) {
                   1536:                 $r->print($othergrp);
                   1537:             }
1.568     raeburn  1538:             &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578     raeburn  1539:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568     raeburn  1540:             &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548     raeburn  1541:         }
1.57      albertel 1542: 
                   1543:     } # end of $parmlev if/else
1.578     raeburn  1544:     $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
                   1545:               ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
                   1546:                             '</span>':'').'</td>');
1.136     albertel 1547: 
1.203     www      1548:     if ($parmlev eq 'full') {
1.136     albertel 1549:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1550:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1551:         my $sessionvaltype=$typeoutpar[$result];
1.560     damieng  1552:         if (!defined($sessionvaltype)) {
                   1553:             $sessionvaltype=$$defaulttype{$which};
                   1554:         }
1.419     bisitz   1555:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.554     raeburn  1556:                   &valout($sessionval,$sessionvaltype,$$name{$which}).'&nbsp;'.
1.57      albertel 1557:                   '</font></td>');
1.136     albertel 1558:     }
1.44      albertel 1559:     $r->print('</tr>');
1.57      albertel 1560:     $r->print("\n");
1.44      albertel 1561: }
1.59      matthew  1562: 
1.561     damieng  1563: # Prints a cell for table mode.
                   1564: #
                   1565: # FIXME: some of these parameter names are uninspired ($which and $value)
                   1566: # Also, it would make more sense to pass the display for this cell rather
                   1567: # than the full display hash and the key to use.
                   1568: #
                   1569: # @param {Apache2::RequestRec} $r - the Apache request
                   1570: # @param {integer} $which - level
                   1571: # @param {string} $defbg - cell background color
                   1572: # @param {integer} $result - the most specific level that is defined for that parameter
                   1573: # @param {array reference} $outpar - array level -> parameter value (when defined)
                   1574: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
                   1575: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
                   1576: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
                   1577: # @param {hash reference} $display - parameter key -> full title for the parameter
                   1578: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568     raeburn  1579: # @param {boolean} $readonly -true if editing not allowed.
1.578     raeburn  1580: # @param {boolean} $ismaplevel - true if level is for a map. 
1.44      albertel 1581: sub print_td {
1.578     raeburn  1582:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
                   1583:         $noeditgrp,$readonly,$ismaplevel)=@_;
                   1584:     my ($ineffect,$recursive,$currval,$currtype,$currlevel);
                   1585:     $ineffect = 0;
                   1586:     $currval = $$outpar[$which];
                   1587:     $currtype = $$typeoutpar[$which];
                   1588:     $currlevel = $which;
                   1589:     if (($result) && ($result == $which)) {
                   1590:         $ineffect = 1;
                   1591:     } 
                   1592:     if ($ismaplevel) {
                   1593:         if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
                   1594:             if (($result) && ($result == $which)) {
                   1595:                 $recursive = 1;
                   1596:             }
                   1597:         } elsif ($$outpar[$which+1] ne '') {
                   1598:             $recursive = 1;
                   1599:             $currlevel = $which+1;
                   1600:             $currval = $$outpar[$currlevel];
                   1601:             $currtype = $$typeoutpar[$currlevel];
                   1602:             if (($result) && ($result == $currlevel)) {
                   1603:                 $ineffect = 1;
                   1604:             }
                   1605:         }
                   1606:     }
                   1607:     $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419     bisitz   1608:               ';" align="center">');
1.437     raeburn  1609:     my $nolink = 0;
1.568     raeburn  1610:     if ($readonly) {
1.552     raeburn  1611:         $nolink = 1;
1.568     raeburn  1612:     } else { 
1.578     raeburn  1613:         if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553     raeburn  1614:             $nolink = 1;
1.568     raeburn  1615:         } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533     raeburn  1616:             $nolink = 1;
1.568     raeburn  1617:         } elsif ($which == 5 || $which ==  6 || $which == 7 || $which == 8) {
                   1618:             if ($noeditgrp) {
                   1619:                 $nolink = 1;
                   1620:             }
                   1621:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1622:             if ($which > 4) {
                   1623:                 $nolink = 1;
                   1624:             }
                   1625:         } elsif ($mprefix =~ /examcode\&$/) {
                   1626:             unless ($which == 2) {
                   1627:                 $nolink = 1;
                   1628:             }
1.533     raeburn  1629:         }
1.437     raeburn  1630:     }
                   1631:     if ($nolink) {
1.577     raeburn  1632:         my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.578     raeburn  1633:         $r->print(&valout($currval,$currtype,$parmname));
1.114     www      1634:     } else {
1.578     raeburn  1635:         $r->print(&plink($currtype,
                   1636:                          $$display{$value},$currval,
                   1637:                          $mprefix.$currlevel,'parmform.pres','psub',$recursive));
1.114     www      1638:     }
                   1639:     $r->print('</td>'."\n");
1.57      albertel 1640: }
                   1641: 
1.561     damieng  1642: # Returns HTML and other info for the cell added when a user is selected
                   1643: # and that user is in several groups. This is the cell with the title "Control by other group".
                   1644: #
                   1645: # @param {string} $what - parameter part.'.'.parameter name
                   1646: # @param {string} $rid - resource id
                   1647: # @param {string} $cgroup - group name
                   1648: # @param {string} $defbg - cell background color
                   1649: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1650: # @param {integer} $result - level
                   1651: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
                   1652: # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group)
1.580     raeburn  1653: sub check_other_groups {
                   1654:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1655:     my $courseid = $env{'request.course.id'};
                   1656:     my $output;
                   1657:     my $symb = &symbcache($rid);
                   1658:     my $symbparm=$symb.'.'.$what;
                   1659:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556     raeburn  1660:     my $recurseparm=$map.'___(rec).'.$what; 
1.275     raeburn  1661:     my $mapparm=$map.'___(all).'.$what;
                   1662:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556     raeburn  1663:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
                   1664:                               $recurseparm,$what,$courseopt);
1.275     raeburn  1665:     my $bgcolor = $defbg;
                   1666:     my $grp_parm;
1.446     bisitz   1667:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.275     raeburn  1668:         if ($result > 3) {
1.419     bisitz   1669:             $bgcolor = '#AAFFAA';
1.275     raeburn  1670:         }
1.554     raeburn  1671:         $grp_parm = &valout($coursereply,$resulttype,$what);
1.419     bisitz   1672:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1673:         if ($resultgroup && $resultlevel) {
                   1674:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                   1675:         } else {
                   1676:             $output .= '&nbsp;';
                   1677:         }
                   1678:         $output .= '</td>';
                   1679:     } else {
1.419     bisitz   1680:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1681:     }
                   1682:     return ($coursereply,$output,$grp_parm,$resultgroup);
                   1683: }
                   1684: 
1.561     damieng  1685: # Looks for a group with a defined parameter for given user and parameter.
1.580     raeburn  1686: # Used by check_other_groups.
1.561     damieng  1687: #
                   1688: # @param {string} $courseid - the course id
                   1689: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   1690: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
                   1691: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
                   1692: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
                   1693: # @param {string} $what - parameter part.'.'.parameter name
                   1694: # @param {hash reference} $courseopt - course parameters hash
                   1695: # @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  1696: sub parm_control_group {
1.556     raeburn  1697:     my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275     raeburn  1698:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1699:     my $grpfound = 0;
1.556     raeburn  1700:     my @levels = ($symbparm,$mapparm,$recurseparm,$what);
                   1701:     my @levelnames = ('resource','map/folder','recursive','general');
1.275     raeburn  1702:     foreach my $group (@{$usersgroups}) {
                   1703:         if ($grpfound) { last; }
                   1704:         for (my $i=0; $i<@levels; $i++) {
                   1705:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1706:             if (defined($$courseopt{$item})) {
                   1707:                 $coursereply = $$courseopt{$item};
                   1708:                 $resultitem = $item;
                   1709:                 $resultgroup = $group;
                   1710:                 $resultlevel = $levelnames[$i];
                   1711:                 $resulttype = $$courseopt{$item.'.type'};
                   1712:                 $grpfound = 1;
                   1713:                 last;
                   1714:             }
                   1715:         }
                   1716:     }
                   1717:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1718: }
1.201     www      1719: 
1.63      bowersj2 1720: 
                   1721: 
1.562     damieng  1722: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
                   1723: # All the parameters are references and are filled by the sub.
                   1724: #
1.566     damieng  1725: # @param {array reference} $ids - resource and map ids
                   1726: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
                   1727: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562     damieng  1728: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   1729: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566     damieng  1730: # @param {hash reference} $allmaps - hash map pc -> map src
                   1731: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
                   1732: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
                   1733: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
                   1734: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562     damieng  1735: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
                   1736: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63      bowersj2 1737: sub extractResourceInformation {
                   1738:     my $ids = shift;
                   1739:     my $typep = shift;
                   1740:     my $keyp = shift;
                   1741:     my $allparms = shift;
                   1742:     my $allparts = shift;
                   1743:     my $allmaps = shift;
                   1744:     my $mapp = shift;
                   1745:     my $symbp = shift;
1.82      www      1746:     my $maptitles=shift;
1.196     www      1747:     my $uris=shift;
1.210     www      1748:     my $keyorder=shift;
1.211     www      1749:     my $defkeytype=shift;
1.196     www      1750: 
1.210     www      1751:     my $keyordercnt=100;
1.63      bowersj2 1752: 
1.196     www      1753:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1754:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1755:     foreach my $resource (@allres) {
1.480     amueller 1756:         my $id=$resource->id();
1.196     www      1757:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1758:         if ($mapid eq '0') { next; }
                   1759:         $$ids[$#$ids+1]=$id;
                   1760:         my $srcf=$resource->src();
                   1761:         $srcf=~/\.(\w+)$/;
                   1762:         $$typep{$id}=$1;
                   1763:         $$keyp{$id}='';
1.196     www      1764:         $$uris{$id}=$srcf;
1.512     foxr     1765: 
1.480     amueller 1766:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                   1767:             next if ($key!~/^parameter_/);
1.363     albertel 1768: 
1.209     www      1769: # Hidden parameters
1.480     amueller 1770:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209     www      1771: #
                   1772: # allparms is a hash of parameter names
                   1773: #
1.480     amueller 1774:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                   1775:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1776:                 my ($display,$parmdis);
                   1777:                 $display = &standard_parameter_names($name);
                   1778:                 if ($display eq '') {
                   1779:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                   1780:                     $parmdis = $display;
                   1781:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1782:                 } else {
                   1783:                     $parmdis = &mt($display);
                   1784:                 }
                   1785:                 $$allparms{$name}=$parmdis;
                   1786:                 if (ref($defkeytype)) {
                   1787:                     $$defkeytype{$name}=
                   1788:                     &Apache::lonnet::metadata($srcf,$key.'.type');
                   1789:                 }
                   1790:             }
1.363     albertel 1791: 
1.209     www      1792: #
                   1793: # allparts is a hash of all parts
                   1794: #
1.480     amueller 1795:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                   1796:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1797: #
                   1798: # Remember all keys going with this resource
                   1799: #
1.480     amueller 1800:             if ($$keyp{$id}) {
                   1801:                 $$keyp{$id}.=','.$key;
                   1802:             } else {
                   1803:                 $$keyp{$id}=$key;
                   1804:             }   
1.210     www      1805: #
                   1806: # Put in order
1.446     bisitz   1807: #
1.480     amueller 1808:             unless ($$keyorder{$key}) {
                   1809:                 $$keyorder{$key}=$keyordercnt;
                   1810:                 $keyordercnt++;
                   1811:             }
1.473     amueller 1812:         }
                   1813: 
                   1814: 
1.480     amueller 1815:         if (!exists($$mapp{$mapid})) {
                   1816:             $$mapp{$id}=
                   1817:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   1818:             $$mapp{$mapid}=$$mapp{$id};
                   1819:             $$allmaps{$mapid}=$$mapp{$id};
                   1820:             if ($mapid eq '1') {
1.532     raeburn  1821:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 1822:             } else {
                   1823:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   1824:             }
                   1825:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  1826:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   1827:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   1828:                                                      # are commented out in rev. 1.57
1.473     amueller 1829:         } else {
1.480     amueller 1830:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 1831:         }
1.480     amueller 1832:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 1833:     }
                   1834: }
                   1835: 
1.208     www      1836: 
1.562     damieng  1837: # Tells if a parameter type is a date.
                   1838: #
                   1839: # @param {string} type - parameter type
                   1840: # @returns{boolean} - true if it is a date
1.213     www      1841: sub isdateparm {
                   1842:     my $type=shift;
                   1843:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1844: }
                   1845: 
1.562     damieng  1846: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 1847: #
1.581   ! raeburn  1848: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      1849: sub parmmenu {
1.581   ! raeburn  1850:     my ($r)=@_;
1.208     www      1851:     $r->print(<<ENDSCRIPT);
                   1852: <script type="text/javascript">
1.454     bisitz   1853: // <![CDATA[
1.208     www      1854:     function checkall(value, checkName) {
1.453     schualex 1855: 
                   1856:         var li = "_li";
                   1857:         var displayOverview = "";
                   1858:         
                   1859:         if (value == false) {
                   1860:             displayOverview = "none"
                   1861:         }
                   1862: 
1.562     damieng  1863:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      1864:             ele = document.forms.parmform.elements[i];
                   1865:             if (ele.name == checkName) {
                   1866:                 document.forms.parmform.elements[i].checked=value;
                   1867:             }
                   1868:         }
                   1869:     }
1.210     www      1870: 
                   1871:     function checkthis(thisvalue, checkName) {
1.562     damieng  1872:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      1873:             ele = document.forms.parmform.elements[i];
                   1874:             if (ele.name == checkName) {
1.562     damieng  1875:                 if (ele.value == thisvalue) {
                   1876:                     document.forms.parmform.elements[i].checked=true;
                   1877:                 }
1.210     www      1878:             }
                   1879:         }
                   1880:     }
                   1881: 
                   1882:     function checkdates() {
1.562     damieng  1883:         checkthis('duedate','pscat');
                   1884:         checkthis('opendate','pscat');
                   1885:         checkthis('answerdate','pscat');
1.218     www      1886:     }
                   1887: 
                   1888:     function checkdisset() {
1.562     damieng  1889:         checkthis('discussend','pscat');
                   1890:         checkthis('discusshide','pscat');
                   1891:         checkthis('discussvote','pscat');
1.218     www      1892:     }
                   1893: 
                   1894:     function checkcontdates() {
1.562     damieng  1895:         checkthis('contentopen','pscat');
                   1896:         checkthis('contentclose','pscat');
1.218     www      1897:     }
1.446     bisitz   1898: 
1.210     www      1899:     function checkvisi() {
1.562     damieng  1900:         checkthis('hiddenresource','pscat');
                   1901:         checkthis('encrypturl','pscat');
                   1902:         checkthis('problemstatus','pscat');
                   1903:         checkthis('contentopen','pscat');
                   1904:         checkthis('opendate','pscat');
1.210     www      1905:     }
                   1906: 
                   1907:     function checkparts() {
1.562     damieng  1908:         checkthis('hiddenparts','pscat');
                   1909:         checkthis('display','pscat');
                   1910:         checkthis('ordered','pscat');
1.210     www      1911:     }
                   1912: 
                   1913:     function checkstandard() {
                   1914:         checkall(false,'pscat');
1.562     damieng  1915:         checkdates();
                   1916:         checkthis('weight','pscat');
                   1917:         checkthis('maxtries','pscat');
                   1918:         checkthis('type','pscat');
                   1919:         checkthis('problemstatus','pscat');
1.210     www      1920:     }
                   1921: 
1.454     bisitz   1922: // ]]>
1.208     www      1923: </script>
                   1924: ENDSCRIPT
1.453     schualex 1925: 
1.491     bisitz   1926:     $r->print('<hr />');
1.581   ! raeburn  1927:     &shortCuts($r);
1.491     bisitz   1928:     $r->print('<hr />');
1.453     schualex 1929: }
1.562     damieng  1930: 
                   1931: # Returns parameter categories.
                   1932: #
                   1933: # @returns {hash} - category name -> title in English
1.465     amueller 1934: sub categories {
                   1935:     return ('time_settings' => 'Time Settings',
                   1936:     'grading' => 'Grading',
                   1937:     'tries' => 'Tries',
                   1938:     'problem_appearance' => 'Problem Appearance',
                   1939:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   1940:     'hiding' => 'Hiding',
                   1941:     'high_level_randomization' => 'High Level Randomization',
                   1942:     'slots' => 'Slots',
                   1943:     'file_submission' => 'File Submission',
                   1944:     'misc' => 'Miscellaneous' ); 
                   1945: }
                   1946: 
1.562     damieng  1947: # Returns the category for each parameter.
                   1948: #
                   1949: # @returns {hash} - parameter name -> category name
1.465     amueller 1950: sub lookUpTableParameter {
                   1951:  
                   1952:     return ( 
                   1953:         'opendate' => 'time_settings',
                   1954:         'duedate' => 'time_settings',
                   1955:         'answerdate' => 'time_settings',
                   1956:         'interval' => 'time_settings',
                   1957:         'contentopen' => 'time_settings',
                   1958:         'contentclose' => 'time_settings',
                   1959:         'discussend' => 'time_settings',
1.560     damieng  1960:         'printstartdate' => 'time_settings',
                   1961:         'printenddate' => 'time_settings',
1.465     amueller 1962:         'weight' => 'grading',
                   1963:         'handgrade' => 'grading',
                   1964:         'maxtries' => 'tries',
                   1965:         'hinttries' => 'tries',
1.503     raeburn  1966:         'randomizeontries' => 'tries',
1.465     amueller 1967:         'type' => 'problem_appearance',
                   1968:         'problemstatus' => 'problem_appearance',
                   1969:         'display' => 'problem_appearance',
                   1970:         'ordered' => 'problem_appearance',
                   1971:         'numbubbles' => 'problem_appearance',
                   1972:         'tol' => 'behaviour_of_input_fields',
                   1973:         'sig' => 'behaviour_of_input_fields',
                   1974:         'turnoffunit' => 'behaviour_of_input_fields',
                   1975:         'hiddenresource' => 'hiding',
                   1976:         'hiddenparts' => 'hiding',
                   1977:         'discusshide' => 'hiding',
                   1978:         'buttonshide' => 'hiding',
                   1979:         'turnoffeditor' => 'hiding',
                   1980:         'encrypturl' => 'hiding',
                   1981:         'randomorder' => 'high_level_randomization',
                   1982:         'randompick' => 'high_level_randomization',
                   1983:         'available' => 'slots',
                   1984:         'useslots' => 'slots',
                   1985:         'availablestudent' => 'slots',
                   1986:         'uploadedfiletypes' => 'file_submission',
                   1987:         'maxfilesize' => 'file_submission',
                   1988:         'cssfile' => 'misc',
                   1989:         'mapalias' => 'misc',
                   1990:         'acc' => 'misc',
                   1991:         'maxcollaborators' => 'misc',
                   1992:         'scoreformat' => 'misc',
1.514     raeburn  1993:         'lenient' => 'grading',
1.519     raeburn  1994:         'retrypartial' => 'tries',
1.521     raeburn  1995:         'discussvote'  => 'misc',
1.533     raeburn  1996:         'examcode' => 'high_level_randomization', 
1.575     raeburn  1997:     );
1.465     amueller 1998: }
                   1999: 
1.562     damieng  2000: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2001: #
                   2002: # @param {string} $name - parameter name
                   2003: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2004: sub whatIsMyCategory {
                   2005:     my $name = shift;
                   2006:     my $catList = shift;
                   2007:     my @list;
                   2008:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2009:     my $cat = $lookUpList{$name};
                   2010:     if (defined($cat)) {
                   2011:         if (!defined($$catList{$cat})){
                   2012:             push @list, ($name);
                   2013:             $$catList{$cat} = \@list;
                   2014:         } else {
                   2015:             push @{${$catList}{$cat}}, ($name);     
                   2016:         }
                   2017:     } else {
                   2018:         if (!defined($$catList{'misc'})){
                   2019:             push @list, ($name);
                   2020:             $$catList{'misc'} = \@list;
                   2021:         } else {
                   2022:             push @{${$catList}{'misc'}}, ($name);     
                   2023:         }
                   2024:     }        
                   2025: }
                   2026: 
1.562     damieng  2027: # Sorts parameter names based on appearance order.
                   2028: #
                   2029: # @param {array reference} name - array reference of parameter names
                   2030: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2031: # @returns {Array} - array of parameter names
1.465     amueller 2032: sub keysindisplayorderCategory {
                   2033:     my ($name,$keyorder)=@_;
                   2034:     return sort {
1.473     amueller 2035:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2036:     } ( @{$name});
                   2037: }
                   2038: 
1.562     damieng  2039: # Returns a hash category name -> order, starting at 1 (integer)
                   2040: #
                   2041: # @returns {hash}
1.467     amueller 2042: sub category_order {
                   2043:     return (
                   2044:         'time_settings' => 1,
                   2045:         'grading' => 2,
                   2046:         'tries' => 3,
                   2047:         'problem_appearance' => 4,
                   2048:         'hiding' => 5,
                   2049:         'behaviour_of_input_fields' => 6,
                   2050:         'high_level_randomization'  => 7,
                   2051:         'slots' => 8,
                   2052:         'file_submission' => 9,
                   2053:         'misc' => 10
                   2054:     );
                   2055: 
                   2056: }
1.453     schualex 2057: 
1.562     damieng  2058: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2059: #
                   2060: # @param {Apache2::RequestRec} $r - the Apache request
                   2061: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2062: # @param {array reference} $pscat - list of selected parameter names
                   2063: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2064: sub parmboxes {
                   2065:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2066:     my %categories = &categories();
1.467     amueller 2067:     my %category_order = &category_order();
1.465     amueller 2068:     my %categoryList = (
                   2069:         'time_settings' => [],
                   2070:         'grading' => [],
                   2071:         'tries' => [],
                   2072:         'problem_appearance' => [],
                   2073:         'behaviour_of_input_fields' => [],
                   2074:         'hiding' => [],
                   2075:         'high_level_randomization' => [],
                   2076:         'slots' => [],
                   2077:         'file_submission' => [],
                   2078:         'misc' => [],
1.489     bisitz   2079:     );
1.510     www      2080: 
1.548     raeburn  2081:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2082:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2083:     }
1.453     schualex 2084:     #part to print the parm-list
1.536     raeburn  2085:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2086:         next if (@{$categoryList{$key}} == 0);
                   2087:         next if ($key eq '');
                   2088:         $r->print('<div class="LC_Box LC_400Box">'
                   2089:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2090:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2091:             next if ($tempkey eq '');
1.536     raeburn  2092:             $r->print('<span class="LC_nobreak">'
                   2093:                      .'<label><input type="checkbox" name="pscat" '
                   2094:                      .'value="'.$tempkey.'" ');
                   2095:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2096:                 $r->print( ' checked="checked"');
                   2097:             }
                   2098:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2099:                                                       : $tempkey)
1.536     raeburn  2100:                      .'</label></span><br />'."\n");
1.465     amueller 2101:         }
1.536     raeburn  2102:         $r->print('</div>');
1.465     amueller 2103:     }
1.536     raeburn  2104:     $r->print("\n");
1.453     schualex 2105: }
1.562     damieng  2106: 
                   2107: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2108: #
1.562     damieng  2109: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2110: sub shortCuts {
1.581   ! raeburn  2111:     my ($r)=@_;
1.453     schualex 2112: 
1.491     bisitz   2113:     # Parameter Selection
                   2114:     $r->print(
                   2115:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2116:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2117:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2118:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2119:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2120:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2121:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2122:        .&Apache::lonhtmlcommon::end_funclist()
                   2123:     );
                   2124: 
                   2125:     # Add Selection for...
                   2126:     $r->print(
                   2127:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2128:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2129:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2130:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2131:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2132:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2133:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2134:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2135:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2136:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2137:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2138:        .&Apache::lonhtmlcommon::end_funclist()
                   2139:     );
1.208     www      2140: }
                   2141: 
1.562     damieng  2142: # Prints HTML to select parts to view (except for the title).
                   2143: # Used by table and overview modes.
                   2144: #
                   2145: # @param {Apache2::RequestRec} $r - the Apache request
                   2146: # @param {hash reference} $allparts - hash parameter part -> part title
                   2147: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2148: sub partmenu {
1.446     bisitz   2149:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2150:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2151:     if ($selsize > 8) {
                   2152:         $selsize = 8;
                   2153:     }
1.446     bisitz   2154: 
1.523     raeburn  2155:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2156:     $r->print('<option value="all"');
1.562     damieng  2157:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2158:     $r->print('>'.&mt('All Parts').'</option>');
                   2159:     my %temphash=();
                   2160:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2161:     foreach my $tempkey (sort {
1.560     damieng  2162:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2163:             } keys(%{$allparts})) {
                   2164:         unless ($tempkey =~ /\./) {
                   2165:             $r->print('<option value="'.$tempkey.'"');
                   2166:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2167:                 $r->print(' selected="selected"');
                   2168:             }
                   2169:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2170:         }
1.208     www      2171:     }
1.446     bisitz   2172:     $r->print('</select>');
1.209     www      2173: }
                   2174: 
1.562     damieng  2175: # Prints HTML to select a user and/or a group.
                   2176: # Used by table mode.
                   2177: #
                   2178: # @param {Apache2::RequestRec} $r - the Apache request
                   2179: # @param {string} $uname - selected user name
                   2180: # @param {string} $id - selected Student/Employee ID
                   2181: # @param {string} $udom - selected user domain
                   2182: # @param {string} $csec - selected section name
                   2183: # @param {string} $cgroup - selected group name
                   2184: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2185: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2186: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2187: sub usermenu {
1.553     raeburn  2188:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2189:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2190:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2191:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2192: 
1.209     www      2193:     my $sections='';
1.300     albertel 2194:     my %sectionhash = &Apache::loncommon::get_sections();
                   2195: 
1.269     raeburn  2196:     my $groups;
1.553     raeburn  2197:     my %grouphash;
                   2198:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2199:         %grouphash = &Apache::longroup::coursegroups();
                   2200:     } elsif ($env{'request.course.groups'} ne '') {
                   2201:         map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2202:     }
1.299     albertel 2203: 
1.412     bisitz   2204:     my $g_s_header='';
                   2205:     my $g_s_footer='';
1.446     bisitz   2206: 
1.552     raeburn  2207:     my $currsec = $env{'request.course.sec'};
                   2208:     if ($currsec) {
                   2209:         $sections=&mt('Section:').' '.$currsec;
                   2210:         if (%grouphash) {
                   2211:             $sections .= ';'.('&nbsp;' x2);
                   2212:         }
                   2213:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2214:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2215:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2216:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2217:         }
                   2218:         $sections .= '>';
1.548     raeburn  2219:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2220:         $sections.='<option value="'.$section.'" '.
                   2221:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2222:                                                               '</option>';
1.209     www      2223:         }
                   2224:         $sections.='</select>';
1.269     raeburn  2225:     }
1.412     bisitz   2226: 
1.552     raeburn  2227:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2228:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2229:         $sections .= qq|
                   2230: <script type="text/javascript">
1.454     bisitz   2231: // <![CDATA[
1.269     raeburn  2232: function group_or_section(caller) {
                   2233:    if (caller == "cgroup") {
                   2234:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2235:            document.parmform.csec.selectedIndex = 0;
                   2236:        }
                   2237:    } else {
                   2238:        if (document.parmform.csec.selectedIndex != 0) {
                   2239:            document.parmform.cgroup.selectedIndex = 0;
                   2240:        }
                   2241:    }
                   2242: }
1.454     bisitz   2243: // ]]>
1.269     raeburn  2244: </script>
                   2245: |;
1.554     raeburn  2246:     } else {
1.269     raeburn  2247:         $sections .= qq|
                   2248: <script type="text/javascript">
1.454     bisitz   2249: // <![CDATA[
1.269     raeburn  2250: function group_or_section(caller) {
                   2251:     return;
                   2252: }
1.454     bisitz   2253: // ]]>
1.269     raeburn  2254: </script>
                   2255: |;
1.446     bisitz   2256:     }
1.299     albertel 2257: 
                   2258:     if (%grouphash) {
1.412     bisitz   2259:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2260:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2261:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2262:         }
                   2263:         $groups .= '>';
1.548     raeburn  2264:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2265:             $groups.='<option value="'.$grp.'" ';
                   2266:             if ($grp eq $cgroup) {
                   2267:                 unless ((defined($uname)) && ($grp eq '')) {
                   2268:                     $groups .=  'selected="selected" ';
                   2269:                 }
                   2270:             } elsif (!defined($cgroup)) {
                   2271:                 if (@{$usersgroups} == 1) {
                   2272:                     if ($grp eq $$usersgroups[0]) {
                   2273:                         $groups .=  'selected="selected" ';
                   2274:                     }
                   2275:                 }
                   2276:             }
                   2277:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2278:         }
                   2279:         $groups.='</select>';
                   2280:     }
1.412     bisitz   2281: 
1.445     neumanie 2282:     if (%sectionhash || %grouphash) {
1.446     bisitz   2283:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2284:         $r->print($sections.$groups);
1.448     bisitz   2285:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2286:     } else {
                   2287:         $r->print($sections); 
1.445     neumanie 2288:     }
1.446     bisitz   2289: 
                   2290:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2291:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2292:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2293:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2294:                  ,$chooseopt));
1.209     www      2295: }
                   2296: 
1.562     damieng  2297: # Prints HTML to select parameters from a list of all parameters.
                   2298: # Uses parmmenu and parmboxes.
                   2299: # Used by table and overview modes.
1.468     amueller 2300: #
1.562     damieng  2301: # @param {Apache2::RequestRec} $r - the Apache request
                   2302: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2303: # @param {array reference} $pscat - list of selected parameter names
                   2304: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2305: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2306: sub displaymenu {
1.581   ! raeburn  2307:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2308: 
1.445     neumanie 2309:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2310:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2311: 
1.581   ! raeburn  2312:     &parmmenu($r);
1.536     raeburn  2313:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2314:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2315:     $r->print(&Apache::loncommon::end_scrollbox());
                   2316: 
                   2317:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2318:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2319:  
1.209     www      2320: }
                   2321: 
1.562     damieng  2322: # Prints HTML to select a map.
                   2323: # Used by table mode and overview mode.
                   2324: #
                   2325: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2326: # @param {hash reference} $allmaps - hash map pc -> map src
                   2327: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2328: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2329: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2330: sub mapmenu {
1.499     raeburn  2331:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2332:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2333:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2334:     my $tree=[];
                   2335:     my $treeinfo={};
                   2336:     if (defined($navmap)) {
1.499     raeburn  2337:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2338:         my $curRes;
                   2339:         my $depth = 0;
1.468     amueller 2340:         my %parent = ();
                   2341:         my $startcount = 5;
                   2342:         my $lastcontainer = $startcount;
                   2343: # preparing what is to show ...
1.461     neumanie 2344:         while ($curRes = $it->next()) {
                   2345:             if ($curRes == $it->BEGIN_MAP()) {
                   2346:                 $depth++;
1.468     amueller 2347:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2348:             }
                   2349:             if ($curRes == $it->END_MAP()) {
                   2350:                 $depth--;
1.468     amueller 2351:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2352:             }
                   2353:             if (ref($curRes)) {
1.468     amueller 2354:                 my $symb = $curRes->symb();
                   2355:                 my $ressymb = $symb;
1.461     neumanie 2356:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2357:                     my $type = 'sequence';
                   2358:                     if ($curRes->is_page()) {
                   2359:                         $type = 'page';
                   2360:                     }
                   2361:                     my $id= $curRes->id();
1.468     amueller 2362:                     my $srcf = $curRes->src();
                   2363:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2364:                     if(!exists($treeinfo->{$id})) {
                   2365:                         push(@$tree,$id);
1.473     amueller 2366:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2367:                         $treeinfo->{$id} = {
1.461     neumanie 2368:                                     depth => $depth,
                   2369:                                     type  => $type,
1.468     amueller 2370:                                     name  => $resource_name,
                   2371:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2372:                                     };
1.462     neumanie 2373:                     }
1.461     neumanie 2374:                 }
                   2375:             }
                   2376:         }
1.462     neumanie 2377:     }
1.473     amueller 2378: # Show it ...    
1.484     amueller 2379:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2380:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2381:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2382:         my $whitespace =
                   2383:             '<img src="'
                   2384:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2385:            .'" alt="" />';
                   2386: 
1.498     bisitz   2387:         # Info about selectable folders/maps
                   2388:         $r->print(
                   2389:             '<div class="LC_info">'
1.508     www      2390:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2391:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2392:            .'</div>'
                   2393:         );
                   2394: 
1.536     raeburn  2395:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2396:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2397: 
1.498     bisitz   2398:         # Display row: "All Maps or Folders"
                   2399:         $r->print(
1.523     raeburn  2400:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2401:            .'<td>'
                   2402:            .'<label>'
                   2403:            .'<input type="radio" name="pschp"'
1.497     bisitz   2404:         );
                   2405:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2406:         $r->print(
                   2407:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2408:            .&mt('All Maps or Folders')
                   2409:            .'</label>'
                   2410:            .'<hr /></td>'
                   2411:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2412:         );
1.497     bisitz   2413: 
1.532     raeburn  2414:         # Display row: "Main Content"
1.468     amueller 2415:         if (exists($$allmaps{1})) {
1.498     bisitz   2416:             $r->print(
                   2417:                 &Apache::loncommon::start_data_table_row()
                   2418:                .'<td>'
                   2419:                .'<label>'
                   2420:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2421:             );
1.497     bisitz   2422:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2423:             $r->print(
                   2424:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2425:                .$$maptitles{1}
                   2426:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2427:                .'</label>'
                   2428:                .'</td>'
                   2429:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2430:             );
                   2431:         }
1.497     bisitz   2432: 
                   2433:         # Display rows for all course maps and folders
1.468     amueller 2434:         foreach my $id (@{$tree}) {
                   2435:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2436:             # Indentation
1.468     amueller 2437:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2438:             my $indent;
                   2439:             for (my $i = 0; $i < $depth; $i++) {
                   2440:                 $indent.= $whitespace;
                   2441:             }
1.461     neumanie 2442:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2443:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2444:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2445:             }
1.468     amueller 2446:             my $symb_name = $$symbp{$id};
                   2447:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2448:             $symb_name = $tail;
1.498     bisitz   2449:             $r->print(
                   2450:                 &Apache::loncommon::start_data_table_row()
                   2451:                .'<td>'
                   2452:                .'<label>'
1.463     bisitz   2453:             );
1.498     bisitz   2454:             # Only offer radio button for folders/maps which can be parameterized
                   2455:             if ($allmaps_inverted{$symb_name}) {
                   2456:                 $r->print(
                   2457:                     '<input type ="radio" name="pschp"'
                   2458:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2459:                 );
                   2460:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2461:                 $r->print('/>');
                   2462:             } else {
                   2463:                 $r->print($whitespace);
1.461     neumanie 2464:             }
1.498     bisitz   2465:             $r->print(
                   2466:                 $indent.$icon.'&nbsp;'
                   2467:                .$treeinfo->{$id}->{name}
                   2468:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2469:                .'</label>'
                   2470:                .'</td>'
                   2471:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2472:             );
1.461     neumanie 2473:         }
1.497     bisitz   2474: 
1.523     raeburn  2475:         $r->print(&Apache::loncommon::end_data_table().
                   2476:                   '<br style="line-height:2px;" />'.
                   2477:                   &Apache::loncommon::end_scrollbox());
1.209     www      2478:     }
                   2479: }
                   2480: 
1.563     damieng  2481: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2482: # Used by table and overview modes.
                   2483: #
                   2484: # @param {Apache2::RequestRec} $r - the Apache request
                   2485: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2486: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2487: sub levelmenu {
1.446     bisitz   2488:     my ($r,$alllevs,$parmlev)=@_;
                   2489: 
1.548     raeburn  2490:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2491:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2492:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2493:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2494:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2495:         if ($parmlev eq $$alllevs{$lev}) {
                   2496:             $r->print(' selected="selected"');
                   2497:         }
                   2498:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2499:     }
1.446     bisitz   2500:     $r->print("</select>");
1.208     www      2501: }
                   2502: 
1.211     www      2503: 
1.563     damieng  2504: # Returns HTML to select a section (with a select HTML element).
                   2505: # Used by overview mode.
                   2506: #
                   2507: # @param {array reference} $selectedsections - list of selected section ids
                   2508: # @returns {string}
1.211     www      2509: sub sectionmenu {
1.553     raeburn  2510:     my ($selectedsections)=@_;
1.300     albertel 2511:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2512:     return '' if (!%sectionhash);
1.300     albertel 2513: 
1.552     raeburn  2514:     my (@possibles,$disabled);
                   2515:     if ($env{'request.course.sec'} ne '') {
                   2516:         @possibles = ($env{'request.course.sec'});
                   2517:         $selectedsections = [$env{'request.course.sec'}];
                   2518:         $disabled = ' disabled="disabled"';
                   2519:     } else {
                   2520:         @possibles = ('all',sort(keys(%sectionhash)));
                   2521:     }
1.553     raeburn  2522:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2523:     foreach my $s (@possibles) {
1.553     raeburn  2524:         $output .= '    <option value="'.$s.'"';
                   2525:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2526:             $output .= ' selected="selected"';
1.473     amueller 2527:         }
1.553     raeburn  2528:         $output .= '>'."$s</option>\n";
1.300     albertel 2529:     }
1.553     raeburn  2530:     $output .= "</select>\n";
                   2531:     return $output;
1.269     raeburn  2532: }
                   2533: 
1.563     damieng  2534: # Returns HTML to select a group (with a select HTML element).
                   2535: # Used by overview mode.
                   2536: #
                   2537: # @param {array reference} $selectedgroups - list of selected group names
                   2538: # @returns {string}
1.269     raeburn  2539: sub groupmenu {
1.553     raeburn  2540:     my ($selectedgroups)=@_;
                   2541:     my %grouphash;
                   2542:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2543:         %grouphash = &Apache::longroup::coursegroups();
                   2544:     } elsif ($env{'request.course.groups'} ne '') {
                   2545:          map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2546:     }
                   2547:     return '' if (!%grouphash);
1.299     albertel 2548: 
1.553     raeburn  2549:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2550:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2551:         $output .= '    <option value="'.$group.'"';
                   2552:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2553:             $output .=  ' selected="selected"';
1.473     amueller 2554:         }
1.553     raeburn  2555:         $output .= '>'."$group</option>\n";
1.211     www      2556:     }
1.553     raeburn  2557:     $output .= "</select>\n";
                   2558:     return $output;
1.211     www      2559: }
                   2560: 
1.563     damieng  2561: # Returns an array with the given parameter split by comma.
                   2562: # Used by assessparms (table mode).
                   2563: #
                   2564: # @param {string} $keyp - the string to split
                   2565: # @returns {Array<string>}
1.210     www      2566: sub keysplit {
                   2567:     my $keyp=shift;
                   2568:     return (split(/\,/,$keyp));
                   2569: }
                   2570: 
1.563     damieng  2571: # Returns the keys in $name, sorted using $keyorder.
                   2572: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2573: # Used by assessparms (table mode) for resource level.
                   2574: #
                   2575: # @param {hash reference} $name - parameter key -> parameter name
                   2576: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2577: # @returns {Array<string>}
1.210     www      2578: sub keysinorder {
                   2579:     my ($name,$keyorder)=@_;
                   2580:     return sort {
1.560     damieng  2581:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2582:     } (keys(%{$name}));
1.210     www      2583: }
                   2584: 
1.563     damieng  2585: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2586: # Used by assessparms (table mode) for map and general levels.
                   2587: #
                   2588: # @param {hash reference} $name - parameter key -> parameter name
                   2589: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2590: # @returns {Array<string>}
1.236     albertel 2591: sub keysinorder_bytype {
                   2592:     my ($name,$keyorder)=@_;
                   2593:     return sort {
1.563     damieng  2594:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2595:         my $tb=(split('_',$b))[-1];
                   2596:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2597:             return ($a cmp $b);
                   2598:         }
                   2599:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2600:     } (keys(%{$name}));
1.236     albertel 2601: }
                   2602: 
1.563     damieng  2603: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2604: # Used by defaultsetter (parameter settings default actions).
                   2605: #
                   2606: # @param {hash reference} $name - hash parameter name -> parameter title
                   2607: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2608: # @returns {Array<string>}
1.211     www      2609: sub keysindisplayorder {
                   2610:     my ($name,$keyorder)=@_;
                   2611:     return sort {
1.560     damieng  2612:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2613:     } (keys(%{$name}));
1.211     www      2614: }
                   2615: 
1.563     damieng  2616: # Prints HTML with a choice to sort results by realm or student first.
                   2617: # Used by overview mode.
                   2618: #
                   2619: # @param {Apache2::RequestRec} $r - the Apache request
                   2620: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2621: sub sortmenu {
                   2622:     my ($r,$sortorder)=@_;
1.236     albertel 2623:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2624:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2625:        $r->print(' checked="checked"');
1.214     www      2626:     }
                   2627:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2628:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2629:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2630:        $r->print(' checked="checked"');
1.214     www      2631:     }
1.236     albertel 2632:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2633:           '</label>');
1.214     www      2634: }
                   2635: 
1.563     damieng  2636: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2637: #
                   2638: # @returns {hash}
1.211     www      2639: sub standardkeyorder {
                   2640:     return ('parameter_0_opendate' => 1,
1.473     amueller 2641:         'parameter_0_duedate' => 2,
                   2642:         'parameter_0_answerdate' => 3,
                   2643:         'parameter_0_interval' => 4,
                   2644:         'parameter_0_weight' => 5,
                   2645:         'parameter_0_maxtries' => 6,
                   2646:         'parameter_0_hinttries' => 7,
                   2647:         'parameter_0_contentopen' => 8,
                   2648:         'parameter_0_contentclose' => 9,
                   2649:         'parameter_0_type' => 10,
                   2650:         'parameter_0_problemstatus' => 11,
                   2651:         'parameter_0_hiddenresource' => 12,
                   2652:         'parameter_0_hiddenparts' => 13,
                   2653:         'parameter_0_display' => 14,
                   2654:         'parameter_0_ordered' => 15,
                   2655:         'parameter_0_tol' => 16,
                   2656:         'parameter_0_sig' => 17,
                   2657:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2658:         'parameter_0_discussend' => 19,
                   2659:         'parameter_0_discusshide' => 20,
                   2660:         'parameter_0_discussvote' => 21,
1.560     damieng  2661:         'parameter_0_printstartdate'  =>  22,
                   2662:         'parameter_0_printenddate' =>  23);
1.211     www      2663: }
                   2664: 
1.59      matthew  2665: 
1.560     damieng  2666: # Table mode UI.
1.563     damieng  2667: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2668: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2669: #
                   2670: # Parameters used from the request:
                   2671: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2672: # cgroup - selected group
                   2673: # command - 'set': direct access to table mode for a resource
                   2674: # csec - selected section
                   2675: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2676: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2677: # id - student/employee ID
                   2678: # parmlev - selected level (full|map|general)
                   2679: # part - selected part (unused ?)
                   2680: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2681: # pres_type - &&&-separated parameter types
                   2682: # pres_value - &&&-separated parameter values
                   2683: # prevvisit - '1' if the user has submitted the form before
                   2684: # pscat (multiple values) - selected parameter names
1.566     damieng  2685: # pschp - selected map pc, or 'all'
1.563     damieng  2686: # psprt (multiple values) - list of selected parameter parts
                   2687: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2688: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2689: # symb - resource symb (when a single resource is selected)
                   2690: # udom - selected user domain
                   2691: # uname - selected user name
                   2692: # url - used only with command 'set', the resource url
                   2693: #
                   2694: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2695: # @param $parm_permission - ref to hash of permissions
                   2696: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2697: sub assessparms {
1.1       www      2698: 
1.568     raeburn  2699:     my ($r,$parm_permission) = @_;
1.201     www      2700: 
1.512     foxr     2701: 
                   2702: # -------------------------------------------------------- Variable declaration
1.566     damieng  2703:     my @ids=(); # resource and map ids
                   2704:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2705:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2706:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2707:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2708:     my %uris=(); # hash resource/map id -> resource src
                   2709:     my %maptitles=(); # hash map pc or src -> map title
                   2710:     my %allmaps=(); # hash map pc -> map src
1.563     damieng  2711:     my %alllevs=(); # hash English level title -> value
                   2712: 
                   2713:     my $uname; # selected user name
                   2714:     my $udom; # selected user domain
                   2715:     my $uhome; # server with the user's files, or 'no_host'
                   2716:     my $csec; # selected section name
                   2717:     my $cgroup; # selected group name
                   2718:     my @usersgroups = (); # list of the user groups
1.446     bisitz   2719: 
1.190     albertel 2720:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2721: 
1.57      albertel 2722:     $alllevs{'Resource Level'}='full';
1.215     www      2723:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2724:     $alllevs{'Course Level'}='general';
                   2725: 
1.563     damieng  2726:     my %allparms; # hash parameter name -> parameter title
                   2727:     my %allparts; # hash parameter part -> part title
1.512     foxr     2728: # ------------------------------------------------------------------------------
                   2729: 
1.210     www      2730: #
                   2731: # Order in which these parameters will be displayed
                   2732: #
1.211     www      2733:     my %keyorder=&standardkeyorder();
                   2734: 
1.512     foxr     2735: #    @ids=();
                   2736: #    %symbp=();       # These seem defined above already.
                   2737: #    %typep=();
1.43      albertel 2738: 
                   2739:     my $message='';
                   2740: 
1.190     albertel 2741:     $csec=$env{'form.csec'};
1.552     raeburn  2742:     if ($env{'request.course.sec'} ne '') {
                   2743:         $csec = $env{'request.course.sec'};    
                   2744:     }
                   2745: 
1.553     raeburn  2746: # Check group privs.
1.269     raeburn  2747:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2748:     my $noeditgrp; 
                   2749:     if ($cgroup ne '') {
                   2750:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2751:             if (($env{'request.course.groups'} eq '') || 
                   2752:                 (!grep(/^\Q$cgroup\E$/,split(/,/,$env{'request.course.groups'})))) {
                   2753:                 $noeditgrp = 1;
                   2754:             }
                   2755:         }
                   2756:     }
1.188     www      2757: 
1.190     albertel 2758:     if      ($udom=$env{'form.udom'}) {
                   2759:     } elsif ($udom=$env{'request.role.domain'}) {
                   2760:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2761:     } else {
1.473     amueller 2762:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2763:     }
1.468     amueller 2764:     
1.43      albertel 2765: 
1.134     albertel 2766:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2767:     my $pschp=$env{'form.pschp'};
1.506     www      2768: 
                   2769: 
1.134     albertel 2770:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      2771:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      2772:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 2773: 
1.43      albertel 2774:     my $pssymb='';
1.57      albertel 2775:     my $parmlev='';
1.446     bisitz   2776: 
1.190     albertel 2777:     unless ($env{'form.parmlev'}) {
1.57      albertel 2778:         $parmlev = 'map';
                   2779:     } else {
1.190     albertel 2780:         $parmlev = $env{'form.parmlev'};
1.57      albertel 2781:     }
1.26      www      2782: 
1.29      www      2783: # ----------------------------------------------- Was this started from grades?
                   2784: 
1.560     damieng  2785:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   2786:             (!$env{'form.dis'})) {
1.473     amueller 2787:         my $url=$env{'form.url'};
                   2788:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   2789:         $pssymb=&Apache::lonnet::symbread($url);
                   2790:         if (!@pscat) { @pscat=('all'); }
                   2791:         $pschp='';
1.57      albertel 2792:         $parmlev = 'full';
1.190     albertel 2793:     } elsif ($env{'form.symb'}) {
1.473     amueller 2794:         $pssymb=$env{'form.symb'};
                   2795:         if (!@pscat) { @pscat=('all'); }
                   2796:         $pschp='';
1.57      albertel 2797:         $parmlev = 'full';
1.43      albertel 2798:     } else {
1.473     amueller 2799:         $env{'form.url'}='';
1.43      albertel 2800:     }
                   2801: 
1.190     albertel 2802:     my $id=$env{'form.id'};
1.43      albertel 2803:     if (($id) && ($udom)) {
1.555     raeburn  2804:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 2805:         if ($uname) {
                   2806:             $id='';
                   2807:         } else {
                   2808:             $message=
1.540     bisitz   2809:                 '<p class="LC_warning">'.
                   2810:                 &mt('Unknown ID [_1] at domain [_2]',
                   2811:                     "'".$id."'","'".$udom."'").
                   2812:                 '</p>';
1.473     amueller 2813:         }
1.43      albertel 2814:     } else {
1.473     amueller 2815:         $uname=$env{'form.uname'};
1.43      albertel 2816:     }
                   2817:     unless ($udom) { $uname=''; }
                   2818:     $uhome='';
                   2819:     if ($uname) {
1.473     amueller 2820:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 2821:         if ($uhome eq 'no_host') {
1.473     amueller 2822:             $message=
1.540     bisitz   2823:                 '<p class="LC_warning">'.
                   2824:                 &mt('Unknown user [_1] at domain [_2]',
                   2825:                     "'".$uname."'","'".$udom."'").
                   2826:                 '</p>';
1.473     amueller 2827:             $uname='';
1.12      www      2828:         } else {
1.473     amueller 2829:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   2830:                           $env{'request.course.id'});
                   2831:             if ($csec eq '-1') {
1.540     bisitz   2832:                 $message=
                   2833:                     '<p class="LC_warning">'.
                   2834:                     &mt('User [_1] at domain [_2] not in this course',
                   2835:                         "'".$uname."'","'".$udom."'").
                   2836:                     '</p>';
1.473     amueller 2837:                 $uname='';
                   2838:                 $csec=$env{'form.csec'};
1.269     raeburn  2839:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 2840:             } else {
                   2841:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   2842:                   ('firstname','middlename','lastname','generation','id'));
                   2843:                 $message="\n<p>\n".&mt("Full Name").": ".
                   2844:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   2845:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   2846:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 2847:             }
1.297     raeburn  2848:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  2849:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  2850:             if (@usersgroups > 0) {
1.306     albertel 2851:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  2852:                     $cgroup = $usersgroups[0];
1.297     raeburn  2853:                 }
1.269     raeburn  2854:             }
1.12      www      2855:         }
1.43      albertel 2856:     }
1.2       www      2857: 
1.43      albertel 2858:     unless ($csec) { $csec=''; }
1.269     raeburn  2859:     unless ($cgroup) { $cgroup=''; }
1.12      www      2860: 
1.14      www      2861: # --------------------------------------------------------- Get all assessments
1.446     bisitz   2862:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 2863:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   2864:                 \%keyorder);
1.63      bowersj2 2865: 
1.57      albertel 2866:     $mapp{'0.0'} = '';
                   2867:     $symbp{'0.0'} = '';
1.99      albertel 2868: 
1.14      www      2869: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  2870:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      2871:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   2872:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   2873:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  2874:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2875:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  2876:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2877:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   2878:         my $totalstored = 0;
1.546     raeburn  2879:         my $now = time;
1.473     amueller 2880:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  2881:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  2882:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  2883:                 next if ($csec ne $env{'request.course.sec'});
                   2884:             }
1.556     raeburn  2885:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  2886:                 next if ($noeditgrp);
1.557     raeburn  2887:             }
                   2888:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   2889:                 $namematch = 'maplevelrecurse';
                   2890:             }
1.556     raeburn  2891:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  2892:                 my (@ok_slots,@fail_slots,@del_slots);
                   2893:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   2894:                 my ($level,@all) =
                   2895:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   2896:                                      $csec,$cgroup,$courseopt);
                   2897:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   2898:                     next if ($slot_name eq '');
                   2899:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   2900:                         push(@ok_slots,$slot_name);
                   2901: 
                   2902:                     } else {
                   2903:                         push(@fail_slots,$slot_name);
                   2904:                     }
                   2905:                 }
                   2906:                 if (@ok_slots) {
                   2907:                     $values[$i] = join(':',@ok_slots);
                   2908:                 } else {
                   2909:                     $values[$i] = '';
                   2910:                 }
                   2911:                 if ($all[$level] ne '') {
                   2912:                     my @existing = split(/:/,$all[$level]);
                   2913:                     foreach my $slot_name (@existing) {
                   2914:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   2915:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   2916:                                 push(@del_slots,$slot_name);
                   2917:                             }
                   2918:                         }
                   2919:                     }
                   2920:                 }
1.554     raeburn  2921:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  2922:                 $name = $1;
1.533     raeburn  2923:                 my $val = $values[$i];
1.549     raeburn  2924:                 my $valmatch = '';
1.533     raeburn  2925:                 if ($name eq 'examcode') {
1.544     raeburn  2926:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   2927:                         $val = 'valid';
                   2928:                     }
1.546     raeburn  2929:                 } elsif ($name eq 'printstartdate') {
                   2930:                     if ($val =~ /^\d+$/) {
                   2931:                         if ($val > $now) {
                   2932:                             $val = 'future';
                   2933:                         }
                   2934:                     } 
                   2935:                 } elsif ($name eq 'printenddate') {
                   2936:                     if ($val =~ /^\d+$/) {
                   2937:                         if ($val < $now) {
                   2938:                             $val = 'past';
                   2939:                         }
                   2940:                     }
1.549     raeburn  2941:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   2942:                     my $stringtype = &get_stringtype($name);
                   2943:                     my $stringmatch = &standard_string_matches($stringtype);
                   2944:                     if (ref($stringmatch) eq 'ARRAY') {
                   2945:                         foreach my $item (@{$stringmatch}) {
                   2946:                             if (ref($item) eq 'ARRAY') {
                   2947:                                 my ($regexpname,$pattern) = @{$item};
                   2948:                                 if ($pattern ne '') {
                   2949:                                     if ($val =~ /$pattern/) {
                   2950:                                         $valmatch = $regexpname;
                   2951:                                         $val = '';
                   2952:                                         last;
                   2953:                                     }
                   2954:                                 }
                   2955:                             }
                   2956:                         }
                   2957:                     }
1.554     raeburn  2958:                 } elsif ($name eq 'interval') {
                   2959:                     my $intervaltype = &get_intervaltype($name);
                   2960:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   2961:                     if (ref($intervalmatch) eq 'ARRAY') {
                   2962:                         foreach my $item (@{$intervalmatch}) {
                   2963:                             if (ref($item) eq 'ARRAY') {
                   2964:                                 my ($regexpname,$pattern) = @{$item};
                   2965:                                 if ($pattern ne '') {
                   2966:                                     if ($val =~ /$pattern/) {
                   2967:                                         $valmatch = $regexpname;
                   2968:                                         $val = '';
                   2969:                                         last;
                   2970:                                     }
                   2971:                                 }
                   2972:                             }
                   2973:                         }
                   2974:                     }
1.533     raeburn  2975:                 }
1.504     raeburn  2976:                 $needsrelease =
1.557     raeburn  2977:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  2978:                 if ($needsrelease) {
1.505     raeburn  2979:                     unless ($got_chostname) {
1.514     raeburn  2980:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  2981:                         $got_chostname = 1;
1.546     raeburn  2982:                     } 
1.557     raeburn  2983:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  2984:                                                           $needsrelease,
                   2985:                                                           $cmajor,$cminor);
1.500     raeburn  2986:                 }
1.437     raeburn  2987:             }
1.504     raeburn  2988:             if ($needsnewer) {
1.557     raeburn  2989:                 undef($namematch);
                   2990:             } else {
                   2991:                 my $currneeded;
                   2992:                 if ($needsrelease) {
                   2993:                     $currneeded = $needsrelease;
                   2994:                 }
                   2995:                 if ($namematch) {
                   2996:                     $needsrelease =
                   2997:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   2998:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   2999:                         unless ($got_chostname) {
                   3000:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3001:                             $got_chostname = 1;
                   3002:                         }
                   3003:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3004:                                                               $needsrelease,
                   3005:                                                               $cmajor,$cminor);
                   3006:                     } else {
                   3007:                         undef($namematch);
                   3008:                     }
                   3009:                 }
                   3010:             }
                   3011:             if ($needsnewer) {
                   3012:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3013:                                                 $cminor,$needsrelease);
                   3014:             } else {
                   3015:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3016:                                      $values[$i],
                   3017:                                      $types[$i],
                   3018:                                      $uname,$udom,$csec,$cgroup);
                   3019:                 $totalstored ++;
                   3020:             }
1.473     amueller 3021:         }
1.68      www      3022: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3023:         if ($totalstored) {
                   3024:             $message.='<p class="LC_warning">'
                   3025:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3026:                      .&Apache::loncommon::help_open_topic('Caching')
                   3027:                      .'</p>';
                   3028:         }
1.68      www      3029:     }
1.57      albertel 3030: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3031:     if ($pscat[0] eq "all") {
                   3032:         @pscat = (keys(%allparms));
                   3033:     }
                   3034:     if (!@pscat) {
                   3035:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3036:     };
                   3037:     if ($psprt[0] eq "all" || !@psprt) {
                   3038:         @psprt = (keys(%allparts));
                   3039:     }
1.2       www      3040: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3041: 
1.531     raeburn  3042:     my $crstype = &Apache::loncommon::course_type();
                   3043:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3044: 
1.548     raeburn  3045:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.563     damieng  3046:             'date_interval','int','float','string') {
1.473     amueller 3047:         $r->print('<input type="hidden" value="'.
1.563     damieng  3048:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3049:             '" name="recent_'.$item.'" />');
1.44      albertel 3050:     }
1.446     bisitz   3051: 
1.459     bisitz   3052:     # ----- Start Parameter Selection
                   3053: 
                   3054:     # Hide parm selection?
                   3055:     $r->print(<<ENDPARMSELSCRIPT);
                   3056: <script type="text/javascript">
                   3057: // <![CDATA[
                   3058: function parmsel_show() {
1.562     damieng  3059:     document.getElementById('parmsel').style.display = "";
                   3060:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3061: }
                   3062: // ]]>
                   3063: </script>
                   3064: ENDPARMSELSCRIPT
1.474     amueller 3065:     
1.445     neumanie 3066:     if (!$pssymb) {
1.563     damieng  3067:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3068:         my $parmselhiddenstyle=' style="display:none"';
                   3069:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3070:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3071:         } else  {
                   3072:            $r->print('<div id="parmsel">');
                   3073:         }
                   3074: 
1.491     bisitz   3075:         # Step 1
1.523     raeburn  3076:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3077:         $r->print('
1.474     amueller 3078: <script type="text/javascript">
1.523     raeburn  3079: // <![CDATA['.
                   3080:                  &showhide_js().'
1.474     amueller 3081: // ]]>
                   3082: </script>
1.523     raeburn  3083: ');
                   3084:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3085:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3086:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3087:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3088:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3089:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3090:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3091:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3092:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3093: 
                   3094:         # Step 2
1.523     raeburn  3095:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581   ! raeburn  3096:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3097: 
                   3098:         # Step 3
1.523     raeburn  3099:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3100:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3101:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3102:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3103:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3104: 
                   3105:         # Update Display Button
1.486     www      3106:         $r->print('<p>'
                   3107:              .'<input type="submit" name="dis"'
1.511     www      3108:              .' value="'.&mt('Update Display').'" />'
1.486     www      3109:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3110:              .'</p>');
                   3111:         $r->print('</div>');
1.491     bisitz   3112: 
1.486     www      3113:         # Offer link to display parameter selection again
                   3114:         $r->print('<p id="parmsellink"');
                   3115:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3116:            $r->print($parmselhiddenstyle);
                   3117:         }
                   3118:         $r->print('>'
                   3119:              .'<a href="javascript:parmsel_show()">'
                   3120:              .&mt('Change Parameter Selection')
                   3121:              .'</a>'
                   3122:              .'</p>');
1.44      albertel 3123:     } else {
1.478     amueller 3124:         # parameter screen for a single resource. 
1.486     www      3125:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3126:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3127:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3128:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3129:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3130:                   '<br />');
                   3131:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3132:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3133:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3134:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3135:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3136:         $r->print('<p>'
1.459     bisitz   3137:              .'<input type="submit" name="dis"'
1.511     www      3138:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3139:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3140:              .'</p>');
1.459     bisitz   3141:     }
1.478     amueller 3142:     
1.486     www      3143:     # ----- End Parameter Selection
1.57      albertel 3144: 
1.459     bisitz   3145:     # Display Messages
                   3146:     $r->print('<div>'.$message.'</div>');
1.210     www      3147: 
1.57      albertel 3148: 
                   3149:     my @temp_pscat;
                   3150:     map {
                   3151:         my $cat = $_;
                   3152:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3153:     } @pscat;
                   3154: 
                   3155:     @pscat = @temp_pscat;
                   3156: 
1.548     raeburn  3157: 
1.209     www      3158:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3159: # ----------------------------------------------------------------- Start Table
1.57      albertel 3160:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3161:         my $csuname=$env{'user.name'};
                   3162:         my $csudom=$env{'user.domain'};
1.568     raeburn  3163:         my $readonly = 1;
                   3164:         if ($parm_permission->{'edit'}) {
                   3165:             undef($readonly); 
                   3166:         }
1.57      albertel 3167: 
1.203     www      3168:         if ($parmlev eq 'full') {
1.506     www      3169: #
                   3170: # This produces the cascading table output of parameters
                   3171: #
1.578     raeburn  3172:             my $coursespan=$csec?8:5;
                   3173:             my $userspan=3;
1.560     damieng  3174:             if ($cgroup ne '') {
1.578     raeburn  3175:                 $coursespan += 3;
1.560     damieng  3176:             }
1.473     amueller 3177: 
1.560     damieng  3178:             $r->print(&Apache::loncommon::start_data_table());
                   3179:             #
                   3180:             # This produces the headers
                   3181:             #
                   3182:             $r->print('<tr><td colspan="5"></td>');
                   3183:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3184:             if ($uname) {
1.473     amueller 3185:                 if (@usersgroups > 1) {
1.560     damieng  3186:                     $userspan ++;
                   3187:                 }
                   3188:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3189:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3190:             }
                   3191:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3192:                 'pie'    => "Parameter in Effect",
                   3193:                 'csv'    => "Current Session Value",
1.472     amueller 3194:                 'rl'     => "Resource Level",
1.473     amueller 3195:                 'ic'     => 'in Course',
                   3196:                 'aut'    => "Assessment URL and Title",
                   3197:                 'type'   => 'Type',
                   3198:                 'emof'   => "Enclosing Map or Folder",
                   3199:                 'part'   => 'Part',
1.472     amueller 3200:                 'pn'     => 'Parameter Name',
1.473     amueller 3201:                 'def'    => 'default',
                   3202:                 'femof'  => 'from Enclosing Map or Folder',
                   3203:                 'gen'    => 'general',
                   3204:                 'foremf' => 'for Enclosing Map or Folder',
                   3205:                 'fr'     => 'for Resource'
                   3206:             );
1.560     damieng  3207:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3208: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3209: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3210: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3211: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3212: 
1.10      www      3213: ENDTABLETWO
1.560     damieng  3214:             if ($csec) {
1.578     raeburn  3215:                 $r->print('<th colspan="3">'.
1.560     damieng  3216:                 &mt("in Section")." $csec</th>");
                   3217:             }
                   3218:             if ($cgroup) {
1.578     raeburn  3219:                 $r->print('<th colspan="3">'.
1.472     amueller 3220:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3221:             }
                   3222:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3223: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3224: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3225: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3226: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3227: ENDTABLEHEADFOUR
1.57      albertel 3228: 
1.560     damieng  3229:             if ($csec) {
1.578     raeburn  3230:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3231:             }
1.473     amueller 3232: 
1.560     damieng  3233:             if ($cgroup) {
1.578     raeburn  3234:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3235:             }
                   3236: 
                   3237:             if ($uname) {
                   3238:                 if (@usersgroups > 1) {
                   3239:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3240:                 }
1.578     raeburn  3241:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3242:             }
                   3243: 
                   3244:             $r->print('</tr>');
1.506     www      3245: #
                   3246: # Done with the headers
                   3247: # 
1.560     damieng  3248:             my $defbgone='';
                   3249:             my $defbgtwo='';
                   3250:             my $defbgthree = '';
1.57      albertel 3251: 
1.560     damieng  3252:             foreach my $rid (@ids) {
1.57      albertel 3253: 
                   3254:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   3255: 
1.446     bisitz   3256:                 if ((!$pssymb &&
1.560     damieng  3257:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3258:                         ||
                   3259:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3260: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3261:                     if ($defbgone eq '#E0E099') {
                   3262:                         $defbgone='#E0E0DD';
1.57      albertel 3263:                     } else {
1.419     bisitz   3264:                         $defbgone='#E0E099';
1.57      albertel 3265:                     }
1.419     bisitz   3266:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3267:                         $defbgtwo='#FFFFDD';
1.57      albertel 3268:                     } else {
1.473     amueller 3269:                         $defbgtwo='#FFFF99';
1.57      albertel 3270:                     }
1.419     bisitz   3271:                     if ($defbgthree eq '#FFBB99') {
                   3272:                         $defbgthree='#FFBBDD';
1.269     raeburn  3273:                     } else {
1.419     bisitz   3274:                         $defbgthree='#FFBB99';
1.269     raeburn  3275:                     }
                   3276: 
1.57      albertel 3277:                     my $thistitle='';
                   3278:                     my %name=   ();
                   3279:                     undef %name;
                   3280:                     my %part=   ();
                   3281:                     my %display=();
                   3282:                     my %type=   ();
                   3283:                     my %default=();
1.196     www      3284:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3285: 
1.506     www      3286:                     my $filter=$env{'form.filter'};
1.548     raeburn  3287:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3288:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.560     damieng  3289:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name');
                   3290:     # We may only want certain parameters listed
                   3291:                             if ($filter) {
                   3292:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3293:                             }
                   3294:                             $name{$tempkeyp}=$parmname;
                   3295:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part');
                   3296: 
                   3297:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display');
                   3298:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3299:                                 my $identifier;
                   3300:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3301:                                     $identifier = $1;
                   3302:                                 }
                   3303:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3304:                             } else {
                   3305:                                 $display{$tempkeyp} = $parmdis;
                   3306:                             }
                   3307:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3308:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3309:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp);
                   3310:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type');
                   3311:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title');
1.57      albertel 3312:                         }
                   3313:                     }
1.548     raeburn  3314:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3315:                     if ($totalparms>0) {
1.560     damieng  3316:                         my $firstrow=1;
1.473     amueller 3317:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   3318:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3319:                              ' rowspan='.$totalparms.
1.419     bisitz   3320:                              '><tt><font size="-1">'.
1.57      albertel 3321:                              join(' / ',split(/\//,$uri)).
                   3322:                              '</font></tt><p><b>'.
1.154     albertel 3323:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3324:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3325:                           &escape($symbp{$rid}).
1.336     albertel 3326:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3327:                              " target=\"_self\">$title");
1.57      albertel 3328: 
                   3329:                         if ($thistitle) {
1.473     amueller 3330:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3331:                         }
                   3332:                         $r->print('</a></b></td>');
1.419     bisitz   3333:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3334:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3335:                                       '</td>');
                   3336: 
1.419     bisitz   3337:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3338:                                       ' rowspan='.$totalparms.
1.238     www      3339:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3340:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3341:                             unless ($firstrow) {
                   3342:                                 $r->print('<tr>');
                   3343:                             } else {
                   3344:                                 undef $firstrow;
                   3345:                             }
1.548     raeburn  3346:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3347:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3348:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.568     raeburn  3349:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly);
1.57      albertel 3350:                         }
                   3351:                     }
                   3352:                 }
                   3353:             } # end foreach ids
1.43      albertel 3354: # -------------------------------------------------- End entry for one resource
1.517     www      3355:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3356:         } # end of  full
1.57      albertel 3357: #--------------------------------------------------- Entry for parm level map
                   3358:         if ($parmlev eq 'map') {
1.419     bisitz   3359:             my $defbgone = '#E0E099';
                   3360:             my $defbgtwo = '#FFFF99';
                   3361:             my $defbgthree = '#FFBB99';
1.57      albertel 3362: 
                   3363:             my %maplist;
                   3364: 
                   3365:             if ($pschp eq 'all') {
1.446     bisitz   3366:                 %maplist = %allmaps;
1.57      albertel 3367:             } else {
                   3368:                 %maplist = ($pschp => $mapp{$pschp});
                   3369:             }
                   3370: 
                   3371: #-------------------------------------------- for each map, gather information
                   3372:             my $mapid;
1.560     damieng  3373:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3374:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3375: 
                   3376: #-----------------------  loop through ids and get all parameter types for map
                   3377: #-----------------------------------------          and associated information
                   3378:                 my %name = ();
                   3379:                 my %part = ();
                   3380:                 my %display = ();
                   3381:                 my %type = ();
                   3382:                 my %default = ();
                   3383:                 my $map = 0;
                   3384: 
1.473     amueller 3385: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3386: 
1.548     raeburn  3387:                 foreach my $id (@ids) {
                   3388:                     ($map)=($id =~ /([\d]*?)\./);
                   3389:                     my $rid = $id;
1.446     bisitz   3390: 
1.57      albertel 3391: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3392: 
1.560     damieng  3393:                     if ($map eq $mapid) {
1.473     amueller 3394:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3395: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3396: 
                   3397: #--------------------------------------------------------------------
                   3398: # @catmarker contains list of all possible parameters including part #s
                   3399: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3400: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3401: # When storing information, store as part 0
                   3402: # When requesting information, request from full part
                   3403: #-------------------------------------------------------------------
1.548     raeburn  3404:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3405:                             my $tempkeyp = $fullkeyp;
                   3406:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3407: 
1.548     raeburn  3408:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3409:                                 $part{$tempkeyp}="0";
                   3410:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3411:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3412:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3413:                                     my $identifier;
                   3414:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3415:                                         $identifier = $1;
                   3416:                                     }
                   3417:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3418:                                 } else {
                   3419:                                     $display{$tempkeyp} = $parmdis;
                   3420:                                 }
                   3421:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3422:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3423:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3424:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3425:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   3426:                               }
                   3427:                         } # end loop through keys
1.560     damieng  3428:                     }
1.57      albertel 3429:                 } # end loop through ids
1.446     bisitz   3430: 
1.57      albertel 3431: #---------------------------------------------------- print header information
1.133     www      3432:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3433:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3434:                 my $tmp="";
1.57      albertel 3435:                 if ($uname) {
1.473     amueller 3436:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3437:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3438:                         &mt('in')." \n";
1.57      albertel 3439:                 } else {
1.401     bisitz   3440:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3441:                 }
1.269     raeburn  3442:                 if ($cgroup) {
1.401     bisitz   3443:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3444:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3445:                     $csec = '';
                   3446:                 } elsif ($csec) {
1.401     bisitz   3447:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3448:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3449:                 }
1.401     bisitz   3450:                 $r->print('<div align="center"><h4>'
                   3451:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3452:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3453:                              ,$tmp
                   3454:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3455:                              )
                   3456:                          ."<br /></h4>\n"
1.422     bisitz   3457:                 );
1.57      albertel 3458: #---------------------------------------------------------------- print table
1.419     bisitz   3459:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3460:                          .&Apache::loncommon::start_data_table_header_row()
                   3461:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3462:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3463:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3464:                          .&Apache::loncommon::end_data_table_header_row()
                   3465:                 );
1.57      albertel 3466: 
1.548     raeburn  3467:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3468:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3469:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3470:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3471:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3472:                            $readonly);
1.57      albertel 3473:                 }
1.422     bisitz   3474:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3475:                          .'</div>'
                   3476:                 );
1.57      albertel 3477:             } # end each map
                   3478:         } # end of $parmlev eq map
                   3479: #--------------------------------- Entry for parm level general (Course level)
                   3480:         if ($parmlev eq 'general') {
1.473     amueller 3481:             my $defbgone = '#E0E099';
1.419     bisitz   3482:             my $defbgtwo = '#FFFF99';
                   3483:             my $defbgthree = '#FFBB99';
1.57      albertel 3484: 
                   3485: #-------------------------------------------- for each map, gather information
                   3486:             my $mapid="0.0";
                   3487: #-----------------------  loop through ids and get all parameter types for map
                   3488: #-----------------------------------------          and associated information
                   3489:             my %name = ();
                   3490:             my %part = ();
                   3491:             my %display = ();
                   3492:             my %type = ();
                   3493:             my %default = ();
1.446     bisitz   3494: 
1.548     raeburn  3495:             foreach $id (@ids) {
                   3496:                 my $rid = $id;
1.446     bisitz   3497: 
1.196     www      3498:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3499: 
                   3500: #--------------------------------------------------------------------
                   3501: # @catmarker contains list of all possible parameters including part #s
                   3502: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3503: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3504: # When storing information, store as part 0
                   3505: # When requesting information, request from full part
                   3506: #-------------------------------------------------------------------
1.548     raeburn  3507:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3508:                     my $tempkeyp = $fullkeyp;
                   3509:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3510:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3511:                         $part{$tempkeyp}="0";
                   3512:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3513:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3514:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3515:                             my $identifier;
                   3516:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3517:                                 $identifier = $1;
                   3518:                             }
                   3519:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3520:                         } else {
                   3521:                             $display{$tempkeyp} = $parmdis;
                   3522:                         }
                   3523:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3524:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3525:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3526:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3527:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1.560     damieng  3528:                     }
1.57      albertel 3529:                 } # end loop through keys
                   3530:             } # end loop through ids
1.446     bisitz   3531: 
1.57      albertel 3532: #---------------------------------------------------- print header information
1.473     amueller 3533:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3534:             $r->print(<<ENDMAPONE);
1.419     bisitz   3535: <center>
                   3536: <h4>$setdef
1.135     albertel 3537: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3538: ENDMAPONE
                   3539:             if ($uname) {
1.473     amueller 3540:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3541:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3542:             } else {
1.135     albertel 3543:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3544:             }
1.446     bisitz   3545: 
1.135     albertel 3546:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3547:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3548:             $r->print("</h4>\n");
1.57      albertel 3549: #---------------------------------------------------------------- print table
1.419     bisitz   3550:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3551:                      .&Apache::loncommon::start_data_table_header_row()
                   3552:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3553:                      .'<th>'.&mt('Default Value').'</th>'
                   3554:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3555:                      .&Apache::loncommon::end_data_table_header_row()
                   3556:             );
1.57      albertel 3557: 
1.548     raeburn  3558:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3559:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3560:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3561:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3562:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3563:                            $readonly);
1.57      albertel 3564:             }
1.419     bisitz   3565:             $r->print(&Apache::loncommon::end_data_table()
                   3566:                      .'</p>'
                   3567:                      .'</center>'
                   3568:             );
1.57      albertel 3569:         } # end of $parmlev eq general
1.43      albertel 3570:     }
1.507     www      3571:     $r->print('</form>');
                   3572:     &endSettingsScreen($r);
                   3573:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3574: } # end sub assessparms
1.30      www      3575: 
1.560     damieng  3576: 
                   3577: 
1.120     www      3578: ##################################################
1.560     damieng  3579: # OVERVIEW MODE
1.207     www      3580: ##################################################
1.124     www      3581: 
1.563     damieng  3582: my $tableopen; # boolean, true if HTML table is already opened
                   3583: 
                   3584: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3585: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3586: # @returns {string}
1.124     www      3587: sub tablestart {
1.576     raeburn  3588:     my ($readonly,$is_map) = @_;
1.124     www      3589:     if ($tableopen) {
1.552     raeburn  3590:         return '';
1.124     www      3591:     } else {
1.552     raeburn  3592:         $tableopen=1;
                   3593:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3594:         if ($readonly) {
                   3595:             $output .= '<th>'.&mt('Current value').'</th>';
                   3596:         } else {
1.576     raeburn  3597:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3598:                        '<th>'.&mt('Set to ...').'</th>';
                   3599:             if ($is_map) {
                   3600:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3601:             }
1.552     raeburn  3602:         }
                   3603:         $output .= '</tr>';
                   3604:         return $output;
1.124     www      3605:     }
                   3606: }
                   3607: 
1.563     damieng  3608: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3609: # @returns {string}
1.124     www      3610: sub tableend {
                   3611:     if ($tableopen) {
1.560     damieng  3612:         $tableopen=0;
                   3613:         return &Apache::loncommon::end_data_table();
1.124     www      3614:     } else {
1.560     damieng  3615:         return'';
1.124     www      3616:     }
                   3617: }
                   3618: 
1.563     damieng  3619: # Reads course and user information.
                   3620: # 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).
                   3621: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3622: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3623: # @param {string} $crs - course number
                   3624: # @param {string} $dom - course domain
                   3625: # @returns {hash reference|Array}
1.207     www      3626: sub readdata {
                   3627:     my ($crs,$dom)=@_;
                   3628: # Read coursedata
                   3629:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3630: # Read userdata
                   3631: 
                   3632:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3633:     foreach my $user (keys(%$classlist)) {
                   3634:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3635:             my ($tuname,$tudom)=($1,$2);
                   3636:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3637:             foreach my $userkey (keys(%{$useropt})) {
                   3638:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3639:                     my $newkey=$userkey;
1.548     raeburn  3640:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3641:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3642:                 }
                   3643:             }
1.473     amueller 3644:         }
                   3645:     }
1.552     raeburn  3646:     if (wantarray) {
                   3647:         return ($resourcedata,$classlist);
                   3648:     } else {
                   3649:         return $resourcedata;
                   3650:     }
1.207     www      3651: }
                   3652: 
                   3653: 
1.563     damieng  3654: # Stores parameter data, using form parameters directly.
                   3655: #
                   3656: # Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data).
                   3657: # set_* (except settext, setipallow, setipdeny) - set a parameter value
                   3658: # del_* - remove a parameter
                   3659: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3660: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3661: # key_* - date values
                   3662: # days_* - for date intervals
                   3663: # hours_* - for date intervals
                   3664: # minutes_* - for date intervals
                   3665: # seconds_* - for date intervals
                   3666: # done_* - for date intervals
                   3667: # typeof_* - parameter type
                   3668: # 
                   3669: # @param {Apache2::RequestRec} $r - the Apache request
                   3670: # @param {string} $crs - course number
                   3671: # @param {string} $dom - course domain
1.208     www      3672: sub storedata {
                   3673:     my ($r,$crs,$dom)=@_;
1.207     www      3674: # Set userlevel immediately
                   3675: # Do an intermediate store of course level
                   3676:     my $olddata=&readdata($crs,$dom);
1.124     www      3677:     my %newdata=();
                   3678:     undef %newdata;
                   3679:     my @deldata=();
1.576     raeburn  3680:     my @delrec=();
                   3681:     my @delnonrec=();
1.124     www      3682:     undef @deldata;
1.504     raeburn  3683:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3684:     my $now = time;
1.560     damieng  3685:     foreach my $key (keys(%env)) {
                   3686:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3687:             my $cmd=$1;
                   3688:             my $thiskey=$2;
1.576     raeburn  3689:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
                   3690:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');
                   3691:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3692:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3693:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3694:                     $altkey = $thiskey;
                   3695:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   3696:                     if ($env{'form.rec_'.$thiskey}) {
                   3697:                         $recursive = 1;
                   3698:                     }
                   3699:                 }
                   3700:             }
1.560     damieng  3701:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 3702:             if ($tuname) {
1.576     raeburn  3703:                 $tkey=$thiskey;
1.560     damieng  3704:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  3705:                 if ($altkey) {
                   3706:                     $tkeynonrec = $tkey; 
                   3707:                     $tkeyrec = $altkey;
                   3708:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   3709:                 }
1.560     damieng  3710:             }
                   3711:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  3712:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   3713:                 if ($cmd eq 'set') {
                   3714:                     $data=$env{$key};
                   3715:                     $valmatch = '';
                   3716:                     $valchk = $data;
                   3717:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3718:                     $text = &mt('Saved modified parameter for');
                   3719:                     if ($typeof eq 'string_questiontype') {
                   3720:                         $name = 'type';
                   3721:                     } elsif ($typeof eq 'string_lenient') {
                   3722:                         $name = 'lenient';
                   3723:                         my $stringmatch = &standard_string_matches($typeof);
                   3724:                         if (ref($stringmatch) eq 'ARRAY') {
                   3725:                             foreach my $item (@{$stringmatch}) {
                   3726:                                 if (ref($item) eq 'ARRAY') {
                   3727:                                     my ($regexpname,$pattern) = @{$item};
                   3728:                                     if ($pattern ne '') {
                   3729:                                         if ($data =~ /$pattern/) {
                   3730:                                             $valmatch = $regexpname;
                   3731:                                             $valchk = '';
                   3732:                                             last;
                   3733:                                         }
1.560     damieng  3734:                                     }
1.549     raeburn  3735:                                 }
                   3736:                             }
                   3737:                         }
1.563     damieng  3738:                     } elsif ($typeof eq 'string_discussvote') {
                   3739:                         $name = 'discussvote';
                   3740:                     } elsif ($typeof eq 'string_examcode') {
                   3741:                         $name = 'examcode';
                   3742:                         if (&Apache::lonnet::validCODE($data)) {
                   3743:                             $valchk = 'valid';
                   3744:                         }
                   3745:                     } elsif ($typeof eq 'string_yesno') {
                   3746:                         if ($thiskey =~ /\.retrypartial$/) {
                   3747:                             $name = 'retrypartial';
                   3748:                         }
1.549     raeburn  3749:                     }
1.563     damieng  3750:                 } elsif ($cmd eq 'datepointer') {
                   3751:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   3752:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3753:                     $text = &mt('Saved modified date for');
                   3754:                     if ($typeof eq 'date_start') {
                   3755:                         if ($thiskey =~ /\.printstartdate$/) {
                   3756:                             $name = 'printstartdate';
                   3757:                             if (($data) && ($data > $now)) {
                   3758:                                 $valchk = 'future';
                   3759:                             }
1.560     damieng  3760:                         }
1.563     damieng  3761:                     } elsif ($typeof eq 'date_end') {
                   3762:                         if ($thiskey =~ /\.printenddate$/) {
                   3763:                             $name = 'printenddate';
                   3764:                             if (($data) && ($data < $now)) {
                   3765:                                 $valchk = 'past';
                   3766:                             }
1.560     damieng  3767:                         }
1.504     raeburn  3768:                     }
1.563     damieng  3769:                 } elsif ($cmd eq 'dateinterval') {
                   3770:                     $data=&get_date_interval_from_form($thiskey);
                   3771:                     if ($thiskey =~ /\.interval$/) {
                   3772:                         $name = 'interval';
                   3773:                         my $intervaltype = &get_intervaltype($name);
                   3774:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   3775:                         if (ref($intervalmatch) eq 'ARRAY') {
                   3776:                             foreach my $item (@{$intervalmatch}) {
                   3777:                                 if (ref($item) eq 'ARRAY') {
                   3778:                                     my ($regexpname,$pattern) = @{$item};
                   3779:                                     if ($pattern ne '') {
                   3780:                                         if ($data =~ /$pattern/) {
                   3781:                                             $valmatch = $regexpname;
                   3782:                                             $valchk = '';
                   3783:                                             last;
                   3784:                                         }
1.560     damieng  3785:                                     }
1.554     raeburn  3786:                                 }
                   3787:                             }
                   3788:                         }
                   3789:                     }
1.563     damieng  3790:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3791:                     $text = &mt('Saved modified date for');
1.554     raeburn  3792:                 }
1.576     raeburn  3793:                 if ($recursive) {
1.563     damieng  3794:                     $namematch = 'maplevelrecurse';
1.560     damieng  3795:                 }
1.563     damieng  3796:                 if (($name ne '') || ($namematch ne '')) {
                   3797:                     my ($needsrelease,$needsnewer);
                   3798:                     if ($name ne '') {
                   3799:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  3800:                         if ($needsrelease) {
                   3801:                             unless ($got_chostname) {
1.563     damieng  3802:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  3803:                                 $got_chostname = 1;
                   3804:                             }
1.563     damieng  3805:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   3806:                                                                 $needsrelease,
                   3807:                                                                 $cmajor,$cminor);
                   3808:                         }
                   3809:                     }
                   3810:                     if ($namematch ne '') {
                   3811:                         if ($needsnewer) {
                   3812:                             undef($namematch);
1.560     damieng  3813:                         } else {
1.563     damieng  3814:                             my $currneeded;
                   3815:                             if ($needsrelease) {
                   3816:                                 $currneeded = $needsrelease;
                   3817:                             }
                   3818:                             $needsrelease =
                   3819:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3820:                             if (($needsrelease) &&
                   3821:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3822:                                 unless ($got_chostname) {
                   3823:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3824:                                     $got_chostname = 1;
                   3825:                                 }
                   3826:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   3827:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   3828:                             } else {
                   3829:                                 undef($namematch);
                   3830:                             }
1.560     damieng  3831:                         }
1.557     raeburn  3832:                     }
1.563     damieng  3833:                     if ($needsnewer) {
                   3834:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   3835:                                                             $chostname,$cmajor,
                   3836:                                                             $cminor,$needsrelease));
                   3837:                         next;
                   3838:                     }
1.504     raeburn  3839:                 }
1.576     raeburn  3840:                 my ($reconlychg,$haschange,$storekey);
                   3841:                 if ($tuname) {
                   3842:                     my $ustorekey;
                   3843:                     if ($altkey) {
                   3844:                         if ($recursive) {
                   3845:                             if (exists($$olddata{$thiskey})) {
                   3846:                                 if ($$olddata{$thiskey} eq $data) {
                   3847:                                     $reconlychg = 1;
                   3848:                                 }
                   3849:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   3850:                             }
                   3851:                             if (exists($$olddata{$altkey})) {
                   3852:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   3853:                                     $haschange = 1;
                   3854:                                 }
                   3855:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   3856:                                 $haschange = 1;
                   3857:                             }
                   3858:                             $ustorekey = $tkeyrec;
                   3859:                         } else {
                   3860:                             if (exists($$olddata{$altkey})) {
                   3861:                                 if ($$olddata{$altkey} eq $data) {
                   3862:                                     $reconlychg = 1;
                   3863:                                 }
                   3864:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   3865:                             }
                   3866:                             if (exists($$olddata{$thiskey})) {
                   3867:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   3868:                                     $haschange = 1;
                   3869:                                 }
                   3870:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   3871:                                 $haschange = 1;
                   3872:                             }
                   3873:                             $ustorekey = $tkeynonrec;
                   3874:                         }
                   3875:                     } else {
                   3876:                         if (exists($$olddata{$tkey})) {
                   3877:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   3878:                                 $haschange = 1;
                   3879:                             }
                   3880:                             $ustorekey = $tkey;
                   3881:                         }
                   3882:                     }
                   3883:                     if ($haschange || $reconlychg)  {
                   3884:                         unless ($env{'form.del_'.$thiskey}) {
                   3885:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   3886:                                                                      $ustorekey.'.type' => $typeof},
                   3887:                                                                      $tudom,$tuname) eq 'ok') {
                   3888:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   3889:                                 $r->print('<br />'.$text.' '.
                   3890:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   3891:                             } else {
                   3892:                                 $r->print('<div class="LC_error">'.
                   3893:                                           &mt('Error saving parameters').'</div>');
                   3894:                             }
                   3895:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   3896:                         }
                   3897:                     }
                   3898:                 } else {
                   3899:                     if ($altkey) {
                   3900:                         if ($recursive) {
                   3901:                             if (exists($$olddata{$thiskey})) {
                   3902:                                 if ($$olddata{$thiskey} eq $data) {
                   3903:                                     $reconlychg = 1;
                   3904:                                 }
                   3905:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   3906:                             }
                   3907:                             if (exists($$olddata{$altkey})) {
                   3908:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   3909:                                     $haschange = 1;
                   3910:                                 }
                   3911:                             } elsif (($data ne '') && (!$reconlychg)) {
                   3912:                                 $haschange = 1;
                   3913:                             }
                   3914:                             $storekey = $altkey;
1.563     damieng  3915:                         } else {
1.576     raeburn  3916:                             if (exists($$olddata{$altkey})) {
                   3917:                                 if ($$olddata{$altkey} eq $data) {
                   3918:                                     $reconlychg = 1;
                   3919:                                 }
                   3920:                                 push(@delrec,($altkey,$altkey.'.type'));
                   3921:                             } 
                   3922:                             if (exists($$olddata{$thiskey})) {
                   3923:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   3924:                                     $haschange = 1;
                   3925:                                 }
                   3926:                             } elsif (($data ne '') && (!$reconlychg)) {
                   3927:                                 $haschange = 1;
                   3928:                             }
                   3929:                             $storekey = $thiskey;
1.563     damieng  3930:                         }
1.560     damieng  3931:                     } else {
1.576     raeburn  3932:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   3933:                             $haschange = 1;
                   3934:                             $storekey = $thiskey;
                   3935:                         }
                   3936:                     }
                   3937:                 }
                   3938:                 if ($reconlychg || $haschange) {
                   3939:                     unless ($env{'form.del_'.$thiskey}) {
                   3940:                         $newdata{$storekey}=$data;
                   3941:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  3942:                     }
                   3943:                 }
                   3944:             } elsif ($cmd eq 'del') {
                   3945:                 if ($tuname) {
1.576     raeburn  3946:                     my $error;
                   3947:                     if ($altkey) {  
                   3948:                         if (exists($$olddata{$altkey})) {
                   3949:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   3950:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   3951:                                 if ($recursive) {
                   3952:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   3953:                                 }
                   3954:                             } elsif ($recursive) {
                   3955:                                 $error = 1;
                   3956:                             }
                   3957:                         }
                   3958:                         if (exists($$olddata{$thiskey})) {
                   3959:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   3960:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   3961:                                 unless ($recursive) {
                   3962:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   3963:                                 }
                   3964:                             } elsif (!$recursive) {
                   3965:                                 $error = 1;
                   3966:                             }
                   3967:                         }
1.560     damieng  3968:                     } else {
1.576     raeburn  3969:                         if (exists($$olddata{$thiskey})) {
                   3970:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   3971:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   3972:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   3973:                             } else {
                   3974:                                 $error = 1;
                   3975:                             }
                   3976:                         }
                   3977:                     }
                   3978:                     if ($error) { 
1.560     damieng  3979:                         $r->print('<div class="LC_error">'.
                   3980:                             &mt('Error deleting parameters').'</div>');
                   3981:                     }
                   3982:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   3983:                 } else {
1.576     raeburn  3984:                     if ($altkey) {
                   3985:                         if (exists($$olddata{$altkey})) {
                   3986:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   3987:                                 push(@deldata,($altkey,$altkey.'.type'));
                   3988:                             }
                   3989:                         }
                   3990:                         if (exists($$olddata{$thiskey})) {
                   3991:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   3992:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   3993:                             }
                   3994:                         }
                   3995:                     } elsif (exists($$olddata{$thiskey})) {
                   3996:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   3997:                     }
1.560     damieng  3998:                 }
1.473     amueller 3999:             }
                   4000:         }
                   4001:     }
1.207     www      4002: # Store all course level
1.144     www      4003:     my $delentries=$#deldata+1;
1.576     raeburn  4004:     my @alldels;
                   4005:     if (@delrec) {
                   4006:         push(@alldels,@delrec);
                   4007:     }
                   4008:     if (@delnonrec) {
                   4009:         push(@alldels,@delnonrec);
                   4010:     }
                   4011:     if (@deldata) {
                   4012:         push(@alldels,@deldata);
                   4013:     }
1.548     raeburn  4014:     my @newdatakeys=keys(%newdata);
1.144     www      4015:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4016:     my ($delresult,$devalidate);
                   4017:     if (@alldels) {
                   4018:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4019:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4020:             &log_parmset(\%loghash,1);
1.576     raeburn  4021:             if ($delentries) {
                   4022:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4023:             }
                   4024:         } elsif ($delentries) {
1.560     damieng  4025:             $r->print('<div class="LC_error">'.
                   4026:                 &mt('Error deleting parameters').'</div>');
                   4027:         }
1.576     raeburn  4028:         $devalidate = 1; 
1.144     www      4029:     }
                   4030:     if ($putentries) {
1.560     damieng  4031:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4032:                     &log_parmset(\%newdata,0);
                   4033:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4034:         } else {
                   4035:             $r->print('<div class="LC_error">'.
                   4036:                 &mt('Error saving parameters').'</div>');
                   4037:         }
1.576     raeburn  4038:         $devalidate = 1; 
                   4039:     }
                   4040:     if ($devalidate) {
1.560     damieng  4041:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4042:     }
1.208     www      4043: }
1.207     www      4044: 
1.563     damieng  4045: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4046: #
                   4047: # @param {string} $key - the key
                   4048: # @returns {Array}
1.208     www      4049: sub extractuser {
                   4050:     my $key=shift;
1.350     albertel 4051:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4052: }
1.206     www      4053: 
1.563     damieng  4054: # Parses a parameter key and returns the components.
                   4055: #
                   4056: # @param {string} $key - 
                   4057: # @param {hash reference} $listdata - 
                   4058: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4059: sub parse_listdata_key {
                   4060:     my ($key,$listdata) = @_;
                   4061:     # split into student/section affected, and
                   4062:     # the realm (folder/resource part and parameter
1.446     bisitz   4063:     my ($student,$realm) =
1.473     amueller 4064:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4065:     # if course wide student would be undefined
                   4066:     if (!defined($student)) {
1.560     damieng  4067:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4068:     }
                   4069:     # strip off the .type if it's not the Question type parameter
                   4070:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4071:         $realm=~s/\.type//;
1.381     albertel 4072:     }
                   4073:     # split into resource+part and parameter name
1.388     albertel 4074:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4075:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4076:     return ($student,$res,$part,$parm);
                   4077: }
                   4078: 
1.563     damieng  4079: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4080: #
                   4081: # @param {Apache2::RequestRec} $r - the Apache request
                   4082: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4083: # @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
                   4084: # @param {string} $sortorder - realmstudent|studentrealm
                   4085: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4086: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4087: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4088: # @returns{integer} - number of $listdata parameters processed
1.208     www      4089: sub listdata {
1.568     raeburn  4090:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4091:     
1.207     www      4092: # Start list output
1.206     www      4093: 
1.122     www      4094:     my $oldsection='';
                   4095:     my $oldrealm='';
                   4096:     my $oldpart='';
1.123     www      4097:     my $pointer=0;
1.124     www      4098:     $tableopen=0;
1.145     www      4099:     my $foundkeys=0;
1.248     albertel 4100:     my %keyorder=&standardkeyorder();
1.381     albertel 4101: 
1.552     raeburn  4102:     my ($secidx,%grouphash);
                   4103:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4104:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4105:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4106:             %grouphash = &Apache::longroup::coursegroups();
                   4107:         } elsif ($env{'request.course.groups'} ne '') {
                   4108:             map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   4109:         }
1.552     raeburn  4110:     }
                   4111: 
1.576     raeburn  4112:     foreach my $key (sort {
1.560     damieng  4113:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4114:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4115: 
1.560     damieng  4116:         # get the numerical order for the param
                   4117:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4118:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4119: 
1.560     damieng  4120:         my $result=0;
1.381     albertel 4121: 
1.560     damieng  4122:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4123:             if ($ares     ne $bres    ) {
1.560     damieng  4124:                 $result = ($ares     cmp $bres);
1.446     bisitz   4125:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4126:                 $result = ($astudent cmp $bstudent);
                   4127:             } elsif ($apart    ne $bpart   ) {
                   4128:                 $result = ($apart    cmp $bpart);
                   4129:             }
                   4130:         } else {
                   4131:             if      ($astudent ne $bstudent) {
                   4132:                 $result = ($astudent cmp $bstudent);
                   4133:             } elsif ($ares     ne $bres    ) {
                   4134:                 $result = ($ares     cmp $bres);
                   4135:             } elsif ($apart    ne $bpart   ) {
                   4136:                 $result = ($apart    cmp $bpart);
                   4137:             }
1.473     amueller 4138:         }
1.446     bisitz   4139: 
1.560     damieng  4140:         if (!$result) {
1.381     albertel 4141:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4142:                 $result = ($aparm <=> $bparm);
1.381     albertel 4143:             } elsif (defined($aparm)) {
1.560     damieng  4144:                 $result = -1;
1.381     albertel 4145:             } elsif (defined($bparm)) {
1.560     damieng  4146:                 $result = 1;
                   4147:             }
1.473     amueller 4148:         }
1.381     albertel 4149: 
1.560     damieng  4150:         $result;
                   4151:         
1.576     raeburn  4152:     } keys(%{$listdata})) { # foreach my $key
                   4153:         my $thiskey = $key;
1.560     damieng  4154:         if ($$listdata{$thiskey.'.type'}) {
                   4155:             my $thistype=$$listdata{$thiskey.'.type'};
                   4156:             if ($$resourcedata{$thiskey.'.type'}) {
                   4157:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4158:             }
                   4159:             my ($middle,$part,$name)=
1.572     damieng  4160:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4161:             my $section=&mt('All Students');
1.576     raeburn  4162:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4163:             if ($middle=~/^\[(.*)\]/) {
                   4164:                 my $issection=$1;
                   4165:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4166:                     my ($stuname,$studom) = ($1,$2);
                   4167:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4168:                         if (ref($classlist) eq 'HASH') {
                   4169:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4170:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4171:                             }
                   4172:                         }
                   4173:                     }
                   4174:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4175:                 } else {
                   4176:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4177:                         if (exists($grouphash{$issection})) {
                   4178:                             $section=&mt('Group').': '.$issection;
                   4179:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4180:                             $section = &mt('Section').': '.$issection;
                   4181:                         } else {
                   4182:                             next; 
1.552     raeburn  4183:                         }
1.560     damieng  4184:                     } else {
                   4185:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4186:                     }
                   4187:                 }
1.560     damieng  4188:                 $middle=~s/^\[(.*)\]//;
                   4189:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4190:                 $readonly = 1;
                   4191:             }
                   4192:             $middle=~s/\.+$//;
                   4193:             $middle=~s/^\.+//;
                   4194:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4195:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4196:             if ($caller eq 'overview') {
                   4197:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4198:                     $mapurl = $1;
                   4199:                     $maplevel = $2;
                   4200:                     $is_map = 1;
                   4201:                 }
                   4202:             } elsif ($caller eq 'newoverview') {
                   4203:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4204:                     $mapurl = $1;
                   4205:                     $maplevel = $2;
                   4206:                     $is_map = 1;
                   4207:                 }
                   4208:             }
                   4209:             if ($is_map) {
1.560     damieng  4210:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4211:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4212:                     if ($caller eq 'newoverview') {
                   4213:                         my $altkey = $thiskey;
                   4214:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4215:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4216:                             $is_recursive = 1;
                   4217:                             if ($$resourcedata{$altkey.'.type'}) {
                   4218:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4219:                             }
                   4220:                             $showval = $$resourcedata{$altkey};
                   4221:                         }
                   4222:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4223:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4224:                         $is_recursive = 1;
                   4225:                     }
1.560     damieng  4226:                 }
                   4227:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4228:             } elsif ($middle) {
                   4229:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4230:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4231:                     ': '.&Apache::lonnet::gettitle($middle).
                   4232:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4233:                     $id.')</span></span>';
                   4234:             }
                   4235:             if ($sortorder eq 'realmstudent') {
                   4236:                 if ($realm ne $oldrealm) {
                   4237:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4238:                     $oldrealm=$realm;
                   4239:                     $oldsection='';
                   4240:                 }
                   4241:                 if ($section ne $oldsection) {
                   4242:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4243:                     $oldsection=$section;
                   4244:                     $oldpart='';
                   4245:                 }
1.552     raeburn  4246:             } else {
1.560     damieng  4247:                 if ($section ne $oldsection) {
                   4248:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4249:                     $oldsection=$section;
                   4250:                     $oldrealm='';
                   4251:                 }
                   4252:                 if ($realm ne $oldrealm) {
                   4253:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4254:                     $oldrealm=$realm;
                   4255:                     $oldpart='';
1.552     raeburn  4256:                 }
                   4257:             }
1.560     damieng  4258:             if ($part ne $oldpart) {
                   4259:                 $r->print(&tableend().
                   4260:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4261:                 $oldpart=$part;
1.556     raeburn  4262:             }
1.560     damieng  4263:     #
                   4264:     # Ready to print
                   4265:     #
1.470     raeburn  4266:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4267:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4268:                 &Apache::loncommon::start_data_table_row().
                   4269:                 '<td><b>'.&mt($parmitem).
                   4270:                 '</b></td>');
                   4271:             unless ($readonly) {
                   4272:                 $r->print('<td><input type="checkbox" name="del_'.
                   4273:                         $thiskey.'" /></td>');
                   4274:             }
                   4275:             $r->print('<td>');
                   4276:             $foundkeys++;
                   4277:             if (&isdateparm($thistype)) {
                   4278:                 my $jskey='key_'.$pointer;
                   4279:                 my $state;
                   4280:                 $pointer++;
                   4281:                 if ($readonly) {
                   4282:                     $state = 'disabled';
                   4283:                 }
                   4284:                 $r->print(
                   4285:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4286:                                                         $jskey,
1.576     raeburn  4287:                                                         $showval,
1.560     damieng  4288:                                                         '',1,$state));
                   4289:                 unless  ($readonly) {
                   4290:                     $r->print(
                   4291:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4292:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4293:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4294:     &date_sanity_info($showval)
1.560     damieng  4295:                     );
                   4296:                 }
                   4297:             } elsif ($thistype eq 'date_interval') {
                   4298:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4299:                           $showval,$readonly));
1.560     damieng  4300:             } elsif ($thistype =~ m/^string/) {
                   4301:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4302:                           $showval,$name,$readonly));
1.560     damieng  4303:             } else {
1.576     raeburn  4304:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4305:             }
1.560     damieng  4306:             unless ($readonly) {
                   4307:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4308:                         $thistype.'" />');
1.552     raeburn  4309:             }
1.576     raeburn  4310:             $r->print('</td>');
                   4311:             if ($is_map) {
                   4312:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4313:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4314:                 } else {
                   4315:                     my ($disabled,$recon,$recoff);
                   4316:                     if ($readonly) {
                   4317:                         $disabled = ' disabled="disabled"';
                   4318:                     }
                   4319:                     if ($is_recursive) {
                   4320:                         $recon = ' checked="checked"';
                   4321:                     } else {
                   4322:                         $recoff = ' checked="checked"';
                   4323:                     }
                   4324:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4325:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4326:                 }
                   4327:             }
                   4328:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4329:         }
1.121     www      4330:     }
1.208     www      4331:     return $foundkeys;
                   4332: }
                   4333: 
1.563     damieng  4334: # Returns a string representing the interval, directly using form data matching the given key.
                   4335: # The returned string may also include information related to proctored exams.
                   4336: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4337: #
                   4338: # @param {string} $key - suffix for form fields related to the interval
                   4339: # @returns {string}
1.385     albertel 4340: sub get_date_interval_from_form {
                   4341:     my ($key) = @_;
                   4342:     my $seconds = 0;
                   4343:     foreach my $which (['days', 86400],
1.473     amueller 4344:                ['hours', 3600],
                   4345:                ['minutes', 60],
                   4346:                ['seconds',  1]) {
1.560     damieng  4347:         my ($name, $factor) = @{ $which };
                   4348:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4349:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4350:         }
1.473     amueller 4351:     }
1.560     damieng  4352:     if (($key =~ /\.interval$/) &&
                   4353:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4354:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4355:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4356:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4357:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4358:                 $seconds .= '_proctor';
                   4359:             }
                   4360:         } else {
                   4361:             $seconds .= $env{'form.done_'.$key}; 
                   4362:         }
                   4363:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4364:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4365:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4366:         }
1.554     raeburn  4367:     }
1.385     albertel 4368:     return $seconds;
                   4369: }
                   4370: 
                   4371: 
1.563     damieng  4372: # Returns HTML to enter a text value for a parameter.
                   4373: #
                   4374: # @param {string} $thiskey - parameter key
                   4375: # @param {string} $showval - the current value
                   4376: # @param {boolean} $readonly - true if the field should not be made editable
                   4377: # @returns {string}
1.383     albertel 4378: sub default_selector {
1.552     raeburn  4379:     my ($thiskey, $showval, $readonly) = @_;
                   4380:     my $disabled;
                   4381:     if ($readonly) {
                   4382:         $disabled = ' disabled="disabled"';
                   4383:     }
                   4384:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4385: }
                   4386: 
1.563     damieng  4387: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4388: #
                   4389: # @param {string} $thiskey - parameter key
                   4390: # @param {string} $showval - the current value
                   4391: # @param {boolean} $readonly - true if the fields should not be made editable
                   4392: # @returns {string}
1.549     raeburn  4393: sub string_ip_selector {
1.552     raeburn  4394:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4395:     my %access = (
                   4396:                    allow => [],
                   4397:                    deny  => [],
                   4398:                  );
                   4399:     if ($showval ne '') {
                   4400:         my @current;
                   4401:         if ($showval =~ /,/) {
                   4402:             @current = split(/,/,$showval);
                   4403:         } else {
                   4404:             @current = ($showval);
                   4405:         }
                   4406:         foreach my $item (@current) {
                   4407:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4408:                 push(@{$access{'deny'}},$1);
                   4409:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4410:                 push(@{$access{'allow'}},$item);
                   4411:             }
                   4412:         }
                   4413:     }
                   4414:     if (!@{$access{'allow'}}) {
                   4415:         @{$access{'allow'}} = ('');
                   4416:     }
                   4417:     if (!@{$access{'deny'}}) {
                   4418:         @{$access{'deny'}} = ('');
                   4419:     }
1.552     raeburn  4420:     my ($disabled,$addmore);
1.567     raeburn  4421:     if ($readonly) {
1.552     raeburn  4422:         $disabled=' disabled="disabled"';
                   4423:     } else {
                   4424:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4425:     }
1.549     raeburn  4426:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4427: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4428:     foreach my $acctype ('allow','deny') {
                   4429:         $output .= '
                   4430: <td valign="top">
                   4431: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4432:   <div class="LC_string_ipacc_inner">'."\n";
                   4433:         my $num = 0;
                   4434:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4435:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4436:             if ($num > 0) {
                   4437:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4438:             }
                   4439:             $output .= '</div>'."\n";
                   4440:             $num ++;
                   4441:         }
                   4442:         $output .= '
1.552     raeburn  4443:   </div>'.$addmore.'
1.549     raeburn  4444: </div>
                   4445: </td>';
                   4446:    }
                   4447:    $output .= '
                   4448: </tr>
                   4449: </table>'."\n";
                   4450:     return $output;
                   4451: }
                   4452: 
1.560     damieng  4453: 
                   4454: { # block using some constants related to parameter types (overview mode)
                   4455: 
1.446     bisitz   4456: my %strings =
1.383     albertel 4457:     (
                   4458:      'string_yesno'
                   4459:              => [[ 'yes', 'Yes' ],
1.560     damieng  4460:                  [ 'no', 'No' ]],
1.383     albertel 4461:      'string_problemstatus'
                   4462:              => [[ 'yes', 'Yes' ],
1.473     amueller 4463:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4464:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4465:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4466:      'string_questiontype'
                   4467:              => [[ 'problem', 'Standard Problem'],
                   4468:                  [ 'survey', 'Survey'],
                   4469:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4470:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4471:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4472:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4473:                  [ 'practice', 'Practice'],
                   4474:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4475:      'string_lenient'
                   4476:              => [['yes', 'Yes' ],
                   4477:                  [ 'no', 'No' ],
1.549     raeburn  4478:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4479:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4480:      'string_discussvote'
                   4481:              => [['yes','Yes'],
                   4482:                  ['notended','Yes, unless discussion ended'],
                   4483:                  ['no','No']],
1.549     raeburn  4484:      'string_ip'
                   4485:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
                   4486:                  ['_denyfrom_',], 'Hostname(s) or IP(s) from which access is disallowed'], 
1.383     albertel 4487:      );
                   4488: 
1.549     raeburn  4489: my %stringmatches = (
                   4490:          'string_lenient'
                   4491:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4492:          'string_ip'
                   4493:               => [['_allowfrom_','[^\!]+'],
                   4494:                   ['_denyfrom_','\!']],
                   4495:     );
                   4496: 
                   4497: my %stringtypes = (
                   4498:                     type         => 'string_questiontype',
                   4499:                     lenient      => 'string_lenient',
                   4500:                     retrypartial => 'string_yesno',
                   4501:                     discussvote  => 'string_discussvote',
                   4502:                     examcode     => 'string_examcode',
                   4503:                     acc          => 'string_ip',
                   4504:                   );
                   4505: 
1.563     damieng  4506: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4507: # Used by courseprefs.
                   4508: #
                   4509: # @param {string} $string_type - a parameter type for strings
                   4510: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4511: sub standard_string_options {
                   4512:     my ($string_type) = @_;
                   4513:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4514:         return $strings{$string_type};
                   4515:     }
                   4516:     return;
                   4517: }
1.383     albertel 4518: 
1.563     damieng  4519: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4520: #
                   4521: # @param {string} $string_type - a parameter type for strings
                   4522: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4523: sub standard_string_matches {
                   4524:     my ($string_type) = @_;
                   4525:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4526:         return $stringmatches{$string_type};
                   4527:     }
                   4528:     return;
                   4529: }
                   4530: 
1.563     damieng  4531: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4532: #
                   4533: # @param {string} $name - parameter name
                   4534: # @returns {string}
1.549     raeburn  4535: sub get_stringtype {
                   4536:     my ($name) = @_;
                   4537:     if (exists($stringtypes{$name})) {
                   4538:         return $stringtypes{$name};
                   4539:     }
                   4540:     return;
                   4541: }
                   4542: 
1.563     damieng  4543: # Returns HTML to edit a string parameter.
                   4544: #
                   4545: # @param {string} $thistype - parameter type
                   4546: # @param {string} $thiskey - parameter key
                   4547: # @param {string} $showval - parameter current value
                   4548: # @param {string} $name - parameter name
                   4549: # @param {boolean} $readonly - true if the values should not be made editable
                   4550: # @returns {string}
1.383     albertel 4551: sub string_selector {
1.552     raeburn  4552:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4553: 
1.383     albertel 4554:     if (!exists($strings{$thistype})) {
1.552     raeburn  4555:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4556:     }
                   4557: 
1.504     raeburn  4558:     my %skiptype;
1.514     raeburn  4559:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4560:             ($thistype eq 'string_lenient') ||
                   4561:             ($thistype eq 'string_discussvote') ||
                   4562:             ($thistype eq 'string_ip') ||
                   4563:             ($name eq 'retrypartial')) {
1.504     raeburn  4564:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4565:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4566:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4567:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4568:             my $parmmatch;
                   4569:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   4570:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   4571:                     if (ref($item) eq 'ARRAY') {
                   4572:                         if ($parmval eq $item->[0]) {
                   4573:                             $parmmatch = $parmval;
                   4574:                             $parmval = '';
                   4575:                             last;
                   4576:                         }
                   4577:                     }
                   4578:                 }
                   4579:             }
                   4580:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  4581:             if ($needsrelease) {
                   4582:                 unless ($got_chostname) {
1.514     raeburn  4583:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  4584:                     $got_chostname = 1;
                   4585:                 }
1.557     raeburn  4586:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  4587:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  4588:                 if ($needsnewer) {
1.549     raeburn  4589:                     if ($parmmatch ne '') {
                   4590:                         $skiptype{$parmmatch} = 1;
                   4591:                     } elsif ($parmval ne '') {
                   4592:                         $skiptype{$parmval} = 1;
                   4593:                     }
1.504     raeburn  4594:                 }
                   4595:             }
                   4596:         }
                   4597:     }
1.549     raeburn  4598: 
                   4599:     if ($thistype eq 'string_ip') {
1.552     raeburn  4600:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.549     raeburn  4601:     }
1.504     raeburn  4602: 
1.552     raeburn  4603:     my ($result,$disabled);
                   4604: 
                   4605:     if ($readonly) {
                   4606:         $disabled = ' disabled="disabled"';
                   4607:     }
1.504     raeburn  4608:     my $numinrow = 3;
                   4609:     if ($thistype eq 'string_problemstatus') {
                   4610:         $numinrow = 2;
                   4611:     } elsif ($thistype eq 'string_questiontype') {
                   4612:         if (keys(%skiptype) > 0) {
                   4613:              $numinrow = 4;
                   4614:         }
                   4615:     }
                   4616:     my $rem;
                   4617:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   4618:         my $i=0;
                   4619:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4620:             next unless (ref($possibilities) eq 'ARRAY');
                   4621:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  4622:             next if ($skiptype{$name});
1.504     raeburn  4623:             $rem = $i%($numinrow);
                   4624:             if ($rem == 0) {
                   4625:                 if ($i > 0) {
                   4626:                     $result .= '</tr>';
                   4627:                 }
                   4628:                 $result .= '<tr>';
                   4629:             }
1.549     raeburn  4630:             my $colspan;
                   4631:             if ($i == @{ $strings{$thistype} }-1) {
                   4632:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   4633:                 if ($rem) {
                   4634:                     my $colsleft = $numinrow - $rem;
                   4635:                     if ($colsleft) {
                   4636:                         $colspan = $colsleft+1;
                   4637:                         $colspan = ' colspan="'.$colspan.'"';
                   4638:                     }
                   4639:                 }
                   4640:             }
                   4641:             my ($add,$onchange,$css_class);
                   4642:             if ($thistype eq 'string_lenient') {
                   4643:                 if ($name eq 'weighted') {
                   4644:                     my $display;
                   4645:                     my %relatives = &Apache::lonlocal::texthash(
                   4646:                                         corrchkd     => 'Correct (checked)',
                   4647:                                         corrunchkd   => 'Correct (unchecked)',
                   4648:                                         incorrchkd   => 'Incorrect (checked)',
                   4649:                                         incorrunchkd => 'Incorrect (unchecked)',
                   4650:                     );
                   4651:                     my %textval = (
                   4652:                                     corrchkd     => '1.0',
                   4653:                                     corrunchkd   => '1.0',
                   4654:                                     incorrchkd   => '0.0',
                   4655:                                     incorrunchkd => '0.0',
                   4656:                     );
                   4657:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   4658:                         $textval{'corrchkd'} = $1;
                   4659:                         $textval{'corrunchkd'} = $2;
                   4660:                         $textval{'incorrchkd'} = $3;
                   4661:                         $textval{'incorrunchkd'} = $4;
                   4662:                         $display = 'inline';
                   4663:                         $showval = $name;
                   4664:                     } else {
                   4665:                         $display = 'none';
                   4666:                     }
                   4667:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   4668:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   4669:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   4670:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   4671:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  4672:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  4673:                                 '</td></tr>';
                   4674:                     }
                   4675:                     $add .= '</table></div>'."\n";
                   4676:                 }
                   4677:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   4678:                 $css_class = ' class="LC_lenient_radio"';
                   4679:             }
                   4680:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  4681:                        '<span class="LC_nobreak"><label>'.
                   4682:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  4683:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  4684:             if ($showval eq $name) {
                   4685:                 $result .= ' checked="checked"';
                   4686:             }
1.549     raeburn  4687:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  4688:             $i++;
                   4689:         }
                   4690:         $result .= '</tr>';
1.473     amueller 4691:     }
1.504     raeburn  4692:     if ($result) {
                   4693:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 4694:     }
                   4695:     return $result;
                   4696: }
                   4697: 
1.554     raeburn  4698: my %intervals =
                   4699:     (
                   4700:      'date_interval'
                   4701:              => [[ 'done', 'Yes' ],
1.558     raeburn  4702:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  4703:                  [ '', 'No' ]],
                   4704:     );
                   4705: 
                   4706: my %intervalmatches = (
                   4707:          'date_interval'
1.559     raeburn  4708:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   4709:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  4710:     );
                   4711: 
                   4712: my %intervaltypes = (
                   4713:                       interval => 'date_interval',
                   4714:     );
                   4715: 
1.563     damieng  4716: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   4717: #
                   4718: # @param {string} $interval_type - a parameter type for intervals
                   4719: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  4720: sub standard_interval_matches {
                   4721:     my ($interval_type) = @_;
                   4722:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   4723:         return $intervalmatches{$interval_type};
                   4724:     }
                   4725:     return;
                   4726: }
                   4727: 
1.563     damieng  4728: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   4729: #
                   4730: # @param {string} $name - parameter name
                   4731: # @returns {string}
1.554     raeburn  4732: sub get_intervaltype {
                   4733:     my ($name) = @_;
                   4734:     if (exists($intervaltypes{$name})) {
                   4735:         return $intervaltypes{$name};
                   4736:     }
                   4737:     return;
                   4738: }
                   4739: 
1.563     damieng  4740: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   4741: # Used by courseprefs.
                   4742: #
                   4743: # @param {string} $interval_type - a parameter type for intervals
                   4744: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  4745: sub standard_interval_options {
                   4746:     my ($interval_type) = @_;
                   4747:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   4748:         return $intervals{$interval_type};
                   4749:     }
                   4750:     return;
                   4751: }
                   4752: 
1.563     damieng  4753: # Returns HTML to edit a date interval parameter.
                   4754: #
                   4755: # @param {string} $thiskey - parameter key
                   4756: # @param {string} $name - parameter name
                   4757: # @param {string} $showval - parameter current value
                   4758: # @param {boolean} $readonly - true if the values should not be made editable
                   4759: # @returns {string}
1.554     raeburn  4760: sub date_interval_selector {
                   4761:     my ($thiskey, $name, $showval, $readonly) = @_;
                   4762:     my ($result,%skipval);
                   4763:     if ($name eq 'interval') {
                   4764:         my $intervaltype = &get_intervaltype($name);
                   4765:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   4766:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   4767:             next unless (ref($possibilities) eq 'ARRAY');
                   4768:             my ($parmval, $description) = @{ $possibilities };
                   4769:             my $parmmatch;
                   4770:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   4771:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   4772:                     if (ref($item) eq 'ARRAY') {
                   4773:                         if ($parmval eq $item->[0]) {
                   4774:                             $parmmatch = $parmval;
                   4775:                             $parmval = '';
                   4776:                             last;
                   4777:                         }
                   4778:                     }
                   4779:                 }
                   4780:             }
                   4781:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   4782:             if ($needsrelease) {
                   4783:                 unless ($got_chostname) {
                   4784:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   4785:                     $got_chostname = 1;
                   4786:                 }
1.557     raeburn  4787:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  4788:                                                        $needsrelease,$cmajor,$cminor);
                   4789:                 if ($needsnewer) {
                   4790:                     if ($parmmatch ne '') {
                   4791:                         $skipval{$parmmatch} = 1;
                   4792:                     } elsif ($parmval ne '') {
                   4793:                         $skipval{$parmval} = 1;
                   4794:                     }
                   4795:                 }
                   4796:             }
                   4797:         }
                   4798:     }
                   4799: 
                   4800:     my $currval = $showval;
                   4801:     foreach my $which (['days', 86400, 31],
                   4802:                ['hours', 3600, 23],
                   4803:                ['minutes', 60, 59],
                   4804:                ['seconds',  1, 59]) {
1.560     damieng  4805:         my ($name, $factor, $max) = @{ $which };
                   4806:         my $amount = int($showval/$factor);
                   4807:         $showval  %= $factor;
                   4808:         my %select = ((map {$_ => $_} (0..$max)),
                   4809:                 'select_form_order' => [0..$max]);
                   4810:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   4811:                             \%select,'',$readonly);
                   4812:         $result .= ' '.&mt($name);
1.554     raeburn  4813:     }
                   4814:     if ($name eq 'interval') {
                   4815:         unless ($skipval{'done'}) {
                   4816:             my $checkedon = '';
1.558     raeburn  4817:             my $checkedproc = '';
                   4818:             my $currproctorkey = '';
                   4819:             my $currprocdisplay = 'hidden';
1.559     raeburn  4820:             my $currdonetext = &mt('Done');
1.554     raeburn  4821:             my $checkedoff = ' checked="checked"';
1.559     raeburn  4822:             if ($currval =~ /^(?:\d+)_done$/) {
                   4823:                 $checkedon = ' checked="checked"';
                   4824:                 $checkedoff = '';
                   4825:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   4826:                 $currdonetext = $1;
1.554     raeburn  4827:                 $checkedon = ' checked="checked"';
                   4828:                 $checkedoff = '';
1.558     raeburn  4829:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   4830:                 $currproctorkey = $1;
                   4831:                 $checkedproc = ' checked="checked"';
                   4832:                 $checkedoff = '';
                   4833:                 $currprocdisplay = 'text';
1.559     raeburn  4834:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   4835:                 $currdonetext = $1;
                   4836:                 $currproctorkey = $2;
                   4837:                 $checkedproc = ' checked="checked"';
                   4838:                 $checkedoff = '';
                   4839:                 $currprocdisplay = 'text';
1.554     raeburn  4840:             }
1.558     raeburn  4841:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  4842:             my $disabled;
                   4843:             if ($readonly) {
                   4844:                 $disabled = ' disabled="disabled"';
                   4845:             }
1.558     raeburn  4846:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  4847:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  4848:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  4849:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  4850:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  4851:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  4852:                        &mt('Yes, with proctor key').'</label>'.
                   4853:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  4854:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  4855:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  4856:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  4857:         }
                   4858:     }
                   4859:     unless ($readonly) {
                   4860:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   4861:     }
                   4862:     return $result;
                   4863: }
                   4864: 
1.563     damieng  4865: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   4866: #
                   4867: # @param {string} $name - parameter name
                   4868: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   4869: # @param {string} $value - parameter value
                   4870: # @param {string} $chostname - course server name
                   4871: # @param {integer} $cmajor - major version number
                   4872: # @param {integer} $cminor - minor version number
                   4873: # @param {string} $needsrelease - release version needed (major.minor)
                   4874: # @returns {string}
1.549     raeburn  4875: sub oldversion_warning {
1.557     raeburn  4876:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   4877:     my $standard_name = &standard_parameter_names($name);
                   4878:     if ($namematch) {
                   4879:         my $level = &standard_parameter_levels($namematch);
                   4880:         my $msg = '';
                   4881:         if ($level) {
                   4882:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   4883:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   4884:         } else {
                   4885:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   4886:                       $standard_name,'<b>','</b>');
                   4887:         }
                   4888:         return '<p class="LC_warning">'.$msg.'<br />'.
                   4889:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4890:                    $cmajor.'.'.$cminor,$chostname,
                   4891:                    $needsrelease).
                   4892:                    '</p>';
                   4893:     }
1.549     raeburn  4894:     my $desc;
                   4895:     my $stringtype = &get_stringtype($name);
                   4896:     if ($stringtype ne '') {
                   4897:         if ($name eq 'examcode') {
                   4898:             $desc = $value;
                   4899:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   4900:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   4901:                 next unless (ref($possibilities) eq 'ARRAY');
                   4902:                 my ($parmval, $description) = @{ $possibilities };
                   4903:                 my $parmmatch;
                   4904:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   4905:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   4906:                         if (ref($item) eq 'ARRAY') {
                   4907:                             my ($regexpname,$pattern) = @{$item};
                   4908:                             if ($parmval eq $regexpname) {
                   4909:                                 if ($value =~ /$pattern/) {
                   4910:                                     $desc = $description; 
                   4911:                                     $parmmatch = 1;
                   4912:                                     last;
                   4913:                                 }
                   4914:                             }
                   4915:                         }
                   4916:                     }
                   4917:                     last if ($parmmatch);
                   4918:                 } elsif ($parmval eq $value) {
                   4919:                     $desc = $description;
                   4920:                     last;
                   4921:                 }
                   4922:             }
                   4923:         }
                   4924:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   4925:         my $now = time;
                   4926:         if ($value =~ /^\d+$/) {
                   4927:             if ($name eq 'printstartdate') {
                   4928:                 if ($value > $now) {
                   4929:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4930:                 }
                   4931:             } elsif ($name eq 'printenddate') {
                   4932:                 if ($value < $now) {
                   4933:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4934:                 }
                   4935:             }
                   4936:         }
                   4937:     }
                   4938:     return '<p class="LC_warning">'.
1.557     raeburn  4939:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   4940:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   4941:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4942:        $cmajor.'.'.$cminor,$chostname,
                   4943:        $needsrelease).
                   4944:        '</p>';
1.549     raeburn  4945: }
                   4946: 
1.560     damieng  4947: } # end of block using some constants related to parameter types
                   4948: 
1.549     raeburn  4949: 
1.563     damieng  4950: 
                   4951: # Shifts all start and end dates in the current course by $shift.
1.389     www      4952: #
1.563     damieng  4953: # @param {integer} $shift - time to shift, in seconds
                   4954: # @returns {string} - error name or 'ok'
1.389     www      4955: sub dateshift {
                   4956:     my ($shift)=@_;
                   4957:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4958:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   4959:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   4960: # ugly retro fix for broken version of types
1.548     raeburn  4961:     foreach my $key (keys(%data)) {
1.389     www      4962:         if ($key=~/\wtype$/) {
                   4963:             my $newkey=$key;
                   4964:             $newkey=~s/type$/\.type/;
                   4965:             $data{$newkey}=$data{$key};
                   4966:             delete $data{$key};
                   4967:         }
                   4968:     }
1.391     www      4969:     my %storecontent=();
1.389     www      4970: # go through all parameters and look for dates
1.548     raeburn  4971:     foreach my $key (keys(%data)) {
1.389     www      4972:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   4973:           my $newdate=$data{$key}+$shift;
1.391     www      4974:           $storecontent{$key}=$newdate;
1.389     www      4975:        }
                   4976:     }
1.391     www      4977:     my $reply=&Apache::lonnet::cput
                   4978:                 ('resourcedata',\%storecontent,$dom,$crs);
                   4979:     if ($reply eq 'ok') {
                   4980:        &log_parmset(\%storecontent);
                   4981:     }
                   4982:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   4983:     return $reply;
1.389     www      4984: }
                   4985: 
1.563     damieng  4986: # Overview mode UI to edit course parameters.
                   4987: #
                   4988: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      4989: sub newoverview {
1.568     raeburn  4990:     my ($r,$parm_permission) = @_;
1.280     albertel 4991: 
1.208     www      4992:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4993:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  4994:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  4995:     my $readonly = 1;
                   4996:     if ($parm_permission->{'edit'}) {
                   4997:         undef($readonly);
                   4998:     }
1.414     droeschl 4999:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5000:         text=>"Overview Mode"});
1.523     raeburn  5001: 
                   5002:     my %loaditems = (
1.549     raeburn  5003:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5004:                     );
                   5005:     my $js = '
                   5006: <script type="text/javascript">
                   5007: // <![CDATA[
                   5008: '.
                   5009:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5010:             &showhide_js()."\n".
1.549     raeburn  5011:             &toggleparmtextbox_js()."\n".
                   5012:             &validateparms_js()."\n".
                   5013:             &ipacc_boxes_js()."\n".
1.558     raeburn  5014:             &done_proctor_js()."\n".
1.523     raeburn  5015: '// ]]>
                   5016: </script>
                   5017: ';
1.549     raeburn  5018: 
1.523     raeburn  5019:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5020:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5021:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5022:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5023:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5024:     $r->print(<<ENDOVER);
1.549     raeburn  5025: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5026: ENDOVER
1.211     www      5027:     my @ids=();
                   5028:     my %typep=();
                   5029:     my %keyp=();
                   5030:     my %allparms=();
                   5031:     my %allparts=();
                   5032:     my %allmaps=();
                   5033:     my %mapp=();
                   5034:     my %symbp=();
                   5035:     my %maptitles=();
                   5036:     my %uris=();
                   5037:     my %keyorder=&standardkeyorder();
                   5038:     my %defkeytype=();
                   5039: 
                   5040:     my %alllevs=();
                   5041:     $alllevs{'Resource Level'}='full';
1.215     www      5042:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5043:     $alllevs{'Course Level'}='general';
                   5044: 
                   5045:     my $csec=$env{'form.csec'};
1.269     raeburn  5046:     my $cgroup=$env{'form.cgroup'};
1.211     www      5047: 
                   5048:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5049:     my $pschp=$env{'form.pschp'};
1.506     www      5050: 
1.211     www      5051:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5052:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5053: 
1.446     bisitz   5054:     my @selected_sections =
1.473     amueller 5055:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5056:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5057:     foreach my $sec (@selected_sections) {
                   5058:         if ($sec eq 'all') {
1.211     www      5059:             @selected_sections = ('all');
                   5060:         }
                   5061:     }
1.552     raeburn  5062:     if ($env{'request.course.sec'} ne '') {
                   5063:         @selected_sections = ($env{'request.course.sec'});
                   5064:     }
1.269     raeburn  5065:     my @selected_groups =
                   5066:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5067: 
                   5068:     my $pssymb='';
                   5069:     my $parmlev='';
1.446     bisitz   5070: 
1.211     www      5071:     unless ($env{'form.parmlev'}) {
                   5072:         $parmlev = 'map';
                   5073:     } else {
                   5074:         $parmlev = $env{'form.parmlev'};
                   5075:     }
                   5076: 
1.446     bisitz   5077:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5078:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5079:                 \%keyorder,\%defkeytype);
1.211     www      5080: 
1.374     albertel 5081:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5082:         @psprt = keys(%allparts);
1.374     albertel 5083:     }
1.211     www      5084: # Menu to select levels, etc
                   5085: 
1.456     bisitz   5086:     $r->print('<div class="LC_Box">');
1.445     neumanie 5087:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5088:     $r->print('<div>');
1.523     raeburn  5089:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5090:     &levelmenu($r,\%alllevs,$parmlev);
                   5091:     if ($parmlev ne 'general') {
1.447     bisitz   5092:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5093:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5094:     }
1.447     bisitz   5095:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5096:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5097:     $r->print('</div></div>');
1.446     bisitz   5098: 
1.456     bisitz   5099:     $r->print('<div class="LC_Box">');
1.452     bisitz   5100:     $r->print('<div>');
1.581   ! raeburn  5101:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5102:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5103:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5104:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5105:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5106:     $r->print('<table>'.
1.553     raeburn  5107:               '<tr><th>'.&mt('Parts').'</th>');
                   5108:     if ($sectionselector) {
                   5109:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5110:     }
                   5111:     if ($groupselector) {
                   5112:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5113:     }
                   5114:     $r->print('</tr><tr><td>');
1.211     www      5115:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5116:     $r->print('</td>');
                   5117:     if ($sectionselector) { 
                   5118:         $r->print('<td>'.$sectionselector.'</td>');
                   5119:     }
                   5120:     if ($groupselector) {
                   5121:         $r->print('<td>'.$groupselector.'</td>');
                   5122:     }
                   5123:     $r->print('</tr></table>');
1.447     bisitz   5124:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5125:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5126:     $r->print('</div></div>');
                   5127: 
1.456     bisitz   5128:     $r->print('<div class="LC_Box">');
1.452     bisitz   5129:     $r->print('<div>');
1.214     www      5130:     my $sortorder=$env{'form.sortorder'};
                   5131:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5132:     &sortmenu($r,$sortorder);
1.445     neumanie 5133:     $r->print('</div></div>');
1.446     bisitz   5134: 
1.214     www      5135:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5136: 
1.211     www      5137: # Build the list data hash from the specified parms
                   5138: 
                   5139:     my $listdata;
                   5140:     %{$listdata}=();
                   5141: 
                   5142:     foreach my $cat (@pscat) {
1.269     raeburn  5143:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5144:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5145:     }
                   5146: 
1.212     www      5147:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5148: 
1.481     amueller 5149:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5150: 
                   5151: # Read modified data
                   5152: 
1.481     amueller 5153:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5154: 
                   5155: # List data
                   5156: 
1.568     raeburn  5157:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5158:     }
                   5159:     $r->print(&tableend());
                   5160:     unless ($readonly) {
                   5161:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5162:     }
1.568     raeburn  5163:     $r->print('</form>');
1.507     www      5164:     &endSettingsScreen($r);
                   5165:     $r->print(&Apache::loncommon::end_page());
1.208     www      5166: }
                   5167: 
1.563     damieng  5168: # Fills $listdata with parameter information.
                   5169: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5170: # The non-type value is always 1.
                   5171: #
                   5172: # @param {string} $cat - parameter name
1.566     damieng  5173: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5174: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5175: # @param {hash reference} $listdata - the parameter data that will be modified
                   5176: # @param {array reference} $psprt - selected parts
                   5177: # @param {array reference} $selections - selected sections
                   5178: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5179: # @param {hash reference} $allmaps - hash map pc -> map src
                   5180: # @param {array reference} $ids - resource and map ids
                   5181: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5182: sub secgroup_lister {
                   5183:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5184:     foreach my $item (@{$selections}) {
                   5185:         foreach my $part (@{$psprt}) {
                   5186:             my $rootparmkey=$env{'request.course.id'};
                   5187:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5188:                 $rootparmkey.='.['.$item.']';
                   5189:             }
                   5190:             if ($parmlev eq 'general') {
                   5191: # course-level parameter
                   5192:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5193:                 $$listdata{$newparmkey}=1;
                   5194:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5195:             } elsif ($parmlev eq 'map') {
                   5196: # map-level parameter
1.548     raeburn  5197:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5198:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5199:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5200:                     $$listdata{$newparmkey}=1;
                   5201:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5202:                 }
                   5203:             } else {
                   5204: # resource-level parameter
                   5205:                 foreach my $rid (@{$ids}) {
                   5206:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5207:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5208:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5209:                     $$listdata{$newparmkey}=1;
                   5210:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5211:                 }
                   5212:             }
                   5213:         }
                   5214:     }
                   5215: }
                   5216: 
1.563     damieng  5217: # UI to edit parameter settings starting with a list of all existing parameters.
                   5218: # (called by setoverview action)
                   5219: #
                   5220: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5221: sub overview {
1.568     raeburn  5222:     my ($r,$parm_permission) = @_;
1.208     www      5223:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5224:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5225:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5226:     my $readonly = 1;
                   5227:     if ($parm_permission->{'edit'}) {
                   5228:         undef($readonly);
                   5229:     }
1.549     raeburn  5230:     my $js = '<script type="text/javascript">'."\n".
                   5231:              '// <![CDATA['."\n".
                   5232:              &toggleparmtextbox_js()."\n".
                   5233:              &validateparms_js()."\n".
                   5234:              &ipacc_boxes_js()."\n".
1.558     raeburn  5235:              &done_proctor_js()."\n".
1.549     raeburn  5236:              '// ]]>'."\n".
                   5237:              '</script>'."\n";
1.414     droeschl 5238:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5239:     text=>"Overview Mode"});
1.549     raeburn  5240:     my %loaditems = (
                   5241:                       'onload'   => "showHideLenient();",
                   5242:                     );
                   5243: 
                   5244:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5245:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5246:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5247:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5248:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5249: 
1.208     www      5250: # Store modified
                   5251: 
1.568     raeburn  5252:     unless ($readonly) {
                   5253:         &storedata($r,$crs,$dom);
                   5254:     }
1.208     www      5255: 
                   5256: # Read modified data
                   5257: 
1.552     raeburn  5258:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5259: 
1.214     www      5260: 
                   5261:     my $sortorder=$env{'form.sortorder'};
                   5262:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5263:     &sortmenu($r,$sortorder);
                   5264: 
1.568     raeburn  5265:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5266: 
                   5267:     if ($readonly) {
                   5268:         $r->print('<p>'.$submitbutton.'</p>');
                   5269:     }
                   5270: 
1.208     www      5271: # List data
                   5272: 
1.568     raeburn  5273:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5274:     $r->print(&tableend().'<p>');
                   5275:     if ($foundkeys) {
                   5276:         unless ($readonly) {
                   5277:             $r->print('<p>'.$submitbutton.'</p>');
                   5278:         }
                   5279:     } else {
                   5280:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5281:     }
                   5282:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5283: }
1.121     www      5284: 
1.560     damieng  5285: # Unused sub.
1.563     damieng  5286: #
                   5287: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5288: sub clean_parameters {
                   5289:     my ($r) = @_;
                   5290:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5291:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5292: 
1.414     droeschl 5293:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5294:         text=>"Clean Parameters"});
1.333     albertel 5295:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5296:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5297:     $r->print(<<ENDOVER);
                   5298: $start_page
                   5299: $breadcrumbs
                   5300: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5301: ENDOVER
                   5302: # Store modified
                   5303: 
                   5304:     &storedata($r,$crs,$dom);
                   5305: 
                   5306: # Read modified data
                   5307: 
                   5308:     my $resourcedata=&readdata($crs,$dom);
                   5309: 
                   5310: # List data
                   5311: 
                   5312:     $r->print('<h3>'.
1.473     amueller 5313:           &mt('These parameters refer to resources that do not exist.').
                   5314:           '</h3>'.
                   5315:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5316:           '<br />');
1.333     albertel 5317:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5318:           '<tr>'.
                   5319:           '<th>'.&mt('Delete').'</th>'.
                   5320:           '<th>'.&mt('Parameter').'</th>'.
                   5321:           '</tr>');
1.333     albertel 5322:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5323:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5324:             && $thiskey=~/\.type$/);
                   5325:         my %data = &parse_key($thiskey);
                   5326:         if (1) { #exists($data{'realm_exists'})
                   5327:             #&& !$data{'realm_exists'}) {
                   5328:             $r->print(&Apache::loncommon::start_data_table_row().
                   5329:                 '<tr>'.
                   5330:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5331: 
                   5332:             $r->print('<td>');
                   5333:             my $display_value = $resourcedata->{$thiskey};
                   5334:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5335:             $display_value =
                   5336:                 &Apache::lonlocal::locallocaltime($display_value);
                   5337:             }
1.470     raeburn  5338:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5339:             $parmitem = &mt($parmitem);
1.560     damieng  5340:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5341:                 $parmitem,$resourcedata->{$thiskey}));
                   5342:             $r->print('<br />');
                   5343:             if ($data{'scope_type'} eq 'all') {
                   5344:                 $r->print(&mt('All users'));
                   5345:             } elsif ($data{'scope_type'} eq 'user') {
                   5346:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581   ! raeburn  5347:             } elsif ($data{'scope_type'} eq 'secgroup') {
        !          5348:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5349:             }
                   5350:             $r->print('<br />');
                   5351:             if ($data{'realm_type'} eq 'all') {
                   5352:                 $r->print(&mt('All Resources'));
                   5353:             } elsif ($data{'realm_type'} eq 'folder') {
                   5354:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5355:             } elsif ($data{'realm_type'} eq 'symb') {
                   5356:             my ($map,$resid,$url) =
                   5357:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5358:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5359:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5360:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5361:             }
                   5362:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5363:             $r->print('</td></tr>');
                   5364: 
1.473     amueller 5365:         }
1.333     albertel 5366:     }
                   5367:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5368:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5369:           '</p></form>');
                   5370:     &endSettingsScreen($r);
                   5371:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5372: }
                   5373: 
1.563     damieng  5374: # UI to shift all dates (called by dateshift1 action).
                   5375: # Used by overview mode.
                   5376: #
                   5377: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5378: sub date_shift_one {
                   5379:     my ($r) = @_;
                   5380:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5381:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5382:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5383: 
1.414     droeschl 5384:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5385:         text=>"Shifting Dates"});
1.390     www      5386:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5387:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5388:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5389:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5390:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5391:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5392:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5393:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5394:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5395:                                                         'timeshifted',
                   5396:                                                         $env{'form.timebase'},,
                   5397:                                                         '').
                   5398:               '</td></tr></table>'.
                   5399:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5400:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5401:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5402:     &endSettingsScreen($r);
1.390     www      5403:     $r->print(&Apache::loncommon::end_page());
                   5404: }
                   5405: 
1.563     damieng  5406: # UI to shift all dates (second form).
                   5407: #
                   5408: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5409: sub date_shift_two {
                   5410:     my ($r) = @_;
                   5411:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5412:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5413:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5414:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5415:         text=>"Shifting Dates"});
1.390     www      5416:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5417:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5418:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5419:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5420:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5421:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5422:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5423:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5424:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5425:     my $delta=$timeshifted-$env{'form.timebase'};
                   5426:     &dateshift($delta);
1.543     bisitz   5427:     $r->print(
                   5428:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5429:         '<br /><br />'.
                   5430:         &Apache::lonhtmlcommon::actionbox(
                   5431:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5432:     &endSettingsScreen($r);
1.390     www      5433:     $r->print(&Apache::loncommon::end_page());
                   5434: }
                   5435: 
1.563     damieng  5436: # Returns the different components of a resourcedata key.
                   5437: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5438: #       realm_exists, parameter_part, parameter_name.
                   5439: # Was used by clean_parameters (which is unused).
                   5440: #
                   5441: # @param {string} $key - the parameter key
                   5442: # @returns {hash}
1.333     albertel 5443: sub parse_key {
                   5444:     my ($key) = @_;
                   5445:     my %data;
                   5446:     my ($middle,$part,$name)=
1.572     damieng  5447:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5448:     $data{'scope_type'} = 'all';
                   5449:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5450:         $data{'scope'} = $1;
                   5451:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5452:             $data{'scope_type'} = 'user';
                   5453:             $data{'scope'} = [$1,$2];
                   5454:         } else {
1.581   ! raeburn  5455:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5456:         }
                   5457:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5458:     }
                   5459:     $middle=~s/\.+$//;
                   5460:     $middle=~s/^\.+//;
                   5461:     $data{'realm_type'}='all';
                   5462:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5463:         $data{'realm'} = $1;
                   5464:         $data{'realm_type'} = 'folder';
                   5465:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5466:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5467:     } elsif ($middle) {
1.560     damieng  5468:         $data{'realm'} = $middle;
                   5469:         $data{'realm_type'} = 'symb';
                   5470:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5471:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5472:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5473:     }
1.446     bisitz   5474: 
1.333     albertel 5475:     $data{'parameter_part'} = $part;
                   5476:     $data{'parameter_name'} = $name;
                   5477: 
                   5478:     return %data;
                   5479: }
                   5480: 
1.239     raeburn  5481: 
1.563     damieng  5482: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5483: sub header {
1.507     www      5484:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5485: }
1.193     albertel 5486: 
                   5487: 
                   5488: 
1.560     damieng  5489: ##################################################
                   5490: # MAIN MENU
                   5491: ##################################################
                   5492: 
1.563     damieng  5493: # Content and problem settings main menu.
                   5494: #
                   5495: # @param {Apache2::RequestRec} $r - the Apache request
                   5496: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5497: sub print_main_menu {
                   5498:     my ($r,$parm_permission)=@_;
                   5499:     #
1.414     droeschl 5500:     $r->print(&header());
1.507     www      5501:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5502:     my $crstype = &Apache::loncommon::course_type();
                   5503:     my $lc_crstype = lc($crstype);
                   5504: 
                   5505:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5506:     $r->print(<<ENDMAINFORMHEAD);
                   5507: <form method="post" enctype="multipart/form-data"
                   5508:       action="/adm/parmset" name="studentform">
                   5509: ENDMAINFORMHEAD
                   5510: #
1.195     albertel 5511:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5512:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5513:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5514:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5515:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  5516:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   5517:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  5518:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5519:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5520:                                         '/'.$env{'request.course.sec'});
                   5521:     }
1.568     raeburn  5522:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   5523:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   5524:                                         '/'.$env{'request.course.sec'});
                   5525:     }
                   5526:     my (%linktext,%linktitle,%url);
                   5527:     if ($parm_permission->{'edit'}) {
                   5528:         %linktext = (
                   5529:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   5530:                      settable        => 'Edit Resource Parameters - Table Mode',
                   5531:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   5532:                     );
                   5533:         %linktitle = (
                   5534:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   5535:                      settable        => 'Set/Modify resource parameters in table mode.',
                   5536:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   5537:                      );
                   5538:     } else {
                   5539:         %linktext = (
                   5540:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   5541:                      settable        => 'View Resource Parameters - Table Mode',
                   5542:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   5543:                    );
                   5544:         %linktitle = (
                   5545:                      newoverview     => 'Display resource parameters in overview mode.',
                   5546:                      settable        => 'Display resource parameters in table mode.',
                   5547:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   5548:                      );
                   5549:     }
                   5550:     if ($mgr) {
                   5551:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   5552:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   5553:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   5554:     } elsif ($vgr) {
                   5555:         $linktext{'resettimes'} = 'Display Student Access Times',
                   5556:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   5557:         $url{'resettimes'} = '/adm/accesstimes';
                   5558:     }
1.193     albertel 5559:     my @menu =
1.507     www      5560:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5561:         items => [
                   5562:           { linktext => 'Portfolio Metadata',
                   5563:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  5564:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  5565:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 5566:             icon =>'contact-new.png'   ,
                   5567:             },
1.568     raeburn  5568:           { linktext => $linktext{'resettimes'},
                   5569:             url => $url{'resettimes'},
                   5570:             permission => ($vgr || $mgr),
                   5571:             linktitle => $linktitle{'resettimes'},
                   5572:             icon => 'start-here.png',
1.473     amueller 5573:             },
1.520     raeburn  5574:           { linktext => 'Blocking Communication/Resource Access',
                   5575:             url => '/adm/setblock',
1.568     raeburn  5576:             permission => ($vcb || $dcm),
1.520     raeburn  5577:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   5578:             icon => 'comblock.png',
                   5579:             },
1.473     amueller 5580:           { linktext => 'Set Parameter Setting Default Actions',
                   5581:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  5582:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 5583:             linktitle =>'Set default actions for parameters.'  ,
                   5584:             icon => 'folder-new.png'  ,
                   5585:             }]},
                   5586:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   5587:         items => [
                   5588:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   5589:             url => '/adm/helper/parameter.helper',
1.568     raeburn  5590:             permission => $parm_permission->{'helper'},
1.473     amueller 5591:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   5592:             icon => 'dialog-information.png'  ,
                   5593:             #help => 'Parameter_Helper',
                   5594:             },
1.568     raeburn  5595:           { linktext => $linktext{'newoverview'},
1.473     amueller 5596:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  5597:             permission => $parm_permission->{'newoverview'},
                   5598:             linktitle => $linktitle{'newoverview'},
                   5599:             icon => 'edit-find.png',
1.473     amueller 5600:             #help => 'Parameter_Overview',
                   5601:             },
1.568     raeburn  5602:           { linktext => $linktext{'settable'},
1.473     amueller 5603:             url => '/adm/parmset?action=settable',
1.568     raeburn  5604:             permission => $parm_permission->{'settable'},
                   5605:             linktitle => $linktitle{'settable'},
                   5606:             icon => 'edit-copy.png',
1.473     amueller 5607:             #help => 'Table_Mode',
                   5608:             }]},
1.417     droeschl 5609:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 5610:          items => [
1.570     raeburn  5611:           { linktext => $linktext{'setoverview'},
1.473     amueller 5612:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  5613:             permission => $parm_permission->{'setoverview'},
                   5614:             linktitle => $linktitle{'setoverview'},
                   5615:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 5616:             #help => 'Parameter_Overview',
                   5617:             },
                   5618:           { linktext => 'Change Log',
                   5619:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  5620:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  5621:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 5622:             icon => 'document-properties.png',
1.473     amueller 5623:             }]}
1.193     albertel 5624:           );
1.414     droeschl 5625:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  5626:     $r->print('</form>');
1.507     www      5627:     &endSettingsScreen($r);
1.539     raeburn  5628:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 5629:     return;
                   5630: }
1.414     droeschl 5631: 
1.416     jms      5632: 
                   5633: 
1.560     damieng  5634: ##################################################
                   5635: # PORTFOLIO METADATA
                   5636: ##################################################
                   5637: 
1.563     damieng  5638: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   5639: # It looks like field titles are not localized.
                   5640: #
                   5641: # @param {Apache2::RequestRec} $r - the Apache request
                   5642: # @param {string} $field_name - metadata field name
                   5643: # @param {string} $field_text - metadata field title, in English unless manually added
                   5644: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 5645: sub output_row {
1.347     banghart 5646:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 5647:     my $output;
1.263     banghart 5648:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   5649:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 5650:     if (!defined($options)) {
1.254     banghart 5651:         $options = 'active,stuadd';
1.261     banghart 5652:         $values = '';
1.252     banghart 5653:     }
1.337     banghart 5654:     if (!($options =~ /deleted/)) {
                   5655:         my @options= ( ['active', 'Show to student'],
1.418     schafran 5656:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 5657:                     ['choices','Provide choices for students to select from']);
1.473     amueller 5658: #           ['onlyone','Student may select only one choice']);
1.337     banghart 5659:         if ($added_flag) {
                   5660:             push @options,['deleted', 'Delete Metadata Field'];
                   5661:         }
1.351     banghart 5662:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   5663:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 5664:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 5665:         foreach my $opt (@options) {
1.560     damieng  5666:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   5667:             $output .= &Apache::loncommon::continue_data_table_row();
                   5668:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   5669:                     <input type="checkbox" name="'.
                   5670:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   5671:                     &mt($opt->[1]).'</label></td>';
                   5672:             $output .= &Apache::loncommon::end_data_table_row();
                   5673:         }
1.351     banghart 5674:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   5675:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 5676:         $output .= &Apache::loncommon::end_data_table_row();
                   5677:         my $multiple_checked;
                   5678:         my $single_checked;
                   5679:         if ($options =~ m/onlyone/) {
1.422     bisitz   5680:             $multiple_checked = '';
1.423     bisitz   5681:             $single_checked = ' checked="checked"';
1.351     banghart 5682:         } else {
1.423     bisitz   5683:             $multiple_checked = ' checked="checked"';
1.422     bisitz   5684:             $single_checked = '';
1.351     banghart 5685:         }
1.560     damieng  5686:         $output .= &Apache::loncommon::continue_data_table_row();
                   5687:         $output .= '<td>'.('&nbsp;' x 10).'
                   5688:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   5689:                     '.&mt('Student may select multiple choices from list').'</td>';
                   5690:         $output .= &Apache::loncommon::end_data_table_row();
                   5691:         $output .= &Apache::loncommon::continue_data_table_row();
                   5692:         $output .= '<td>'.('&nbsp;' x 10).'
                   5693:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   5694:                     '.&mt('Student may select only one choice from list').'</td>';
                   5695:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 5696:     }
                   5697:     return ($output);
                   5698: }
1.416     jms      5699: 
                   5700: 
1.560     damieng  5701: # UI to order portfolio metadata fields.
1.563     damieng  5702: # Currently useless because addmetafield does not work.
                   5703: #
                   5704: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 5705: sub order_meta_fields {
                   5706:     my ($r)=@_;
                   5707:     my $idx = 1;
                   5708:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5709:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5710:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 5711:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  5712:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5713:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5714:         text=>"Add Metadata Field"});
1.560     damieng  5715:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5716:         {href=>"/adm/parmset?action=setrestrictmeta",
                   5717:         text=>"Restrict Metadata"},
                   5718:         {text=>"Order Metadata"});
1.345     banghart 5719:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  5720:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 5721:     if ($env{'form.storeorder'}) {
                   5722:         my $newpos = $env{'form.newpos'} - 1;
                   5723:         my $currentpos = $env{'form.currentpos'} - 1;
                   5724:         my @neworder = ();
1.548     raeburn  5725:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5726:         my $i;
1.341     banghart 5727:         if ($newpos > $currentpos) {
1.340     banghart 5728:         # moving stuff up
                   5729:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  5730:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5731:             }
                   5732:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  5733:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 5734:             }
                   5735:             $neworder[$newpos]=$oldorder[$currentpos];
                   5736:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  5737:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5738:             }
                   5739:         } else {
                   5740:         # moving stuff down
1.473     amueller 5741:             for ($i=0;$i<$newpos;$i++) {
                   5742:                 $neworder[$i]=$oldorder[$i];
                   5743:             }
                   5744:             $neworder[$newpos]=$oldorder[$currentpos];
                   5745:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   5746:                 $neworder[$i]=$oldorder[$i-1];
                   5747:             }
                   5748:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   5749:                 $neworder[$i]=$oldorder[$i];
                   5750:             }
1.340     banghart 5751:         }
1.560     damieng  5752:         my $ordered_fields = join ",", @neworder;
1.343     banghart 5753:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  5754:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5755:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 5756:     }
1.357     raeburn  5757:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 5758:     my $ordered_fields;
1.548     raeburn  5759:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5760:     if (!@fields_in_order) {
                   5761:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  5762:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 5763:             push @fields_in_order, $key;
1.341     banghart 5764:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 5765:         }
1.341     banghart 5766:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   5767:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5768:     }
1.340     banghart 5769:     $r->print('<table>');
                   5770:     my $num_fields = scalar(@fields_in_order);
                   5771:     foreach my $key (@fields_in_order) {
                   5772:         $r->print('<tr><td>');
                   5773:         $r->print('<form method="post" action="">');
1.537     bisitz   5774:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 5775:         for (my $i = 1;$i le $num_fields;$i ++) {
                   5776:             if ($i eq $idx) {
                   5777:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   5778:             } else {
                   5779:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   5780:             }
                   5781:         }
                   5782:         $r->print('</select></td><td>');
                   5783:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   5784:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   5785:         $r->print('</form>');
                   5786:         $r->print($$fields{$key}.'</td></tr>');
                   5787:         $idx ++;
                   5788:     }
                   5789:     $r->print('</table>');
1.507     www      5790:     &endSettingsScreen($r);
1.340     banghart 5791:     return 'ok';
                   5792: }
1.416     jms      5793: 
                   5794: 
1.563     damieng  5795: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   5796: # @returns {string}
1.359     banghart 5797: sub continue {
                   5798:     my $output;
                   5799:     $output .= '<form action="" method="post">';
                   5800:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   5801:     $output .= '<input type="submit" value="Continue" />';
                   5802:     return ($output);
                   5803: }
1.416     jms      5804: 
                   5805: 
1.563     damieng  5806: # UI to add a metadata field.
                   5807: # Currenly does not work because of an HTML error (the field is not visible).
                   5808: #
                   5809: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 5810: sub addmetafield {
                   5811:     my ($r)=@_;
1.414     droeschl 5812:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5813:         text=>"Add Metadata Field"});
1.334     banghart 5814:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   5815:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 5816:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5817:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5818:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5819:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 5820:     if (exists($env{'form.undelete'})) {
1.358     banghart 5821:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 5822:         foreach my $meta_field(@meta_fields) {
                   5823:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   5824:             $options =~ s/deleted//;
                   5825:             $options =~ s/,,/,/;
                   5826:             my $put_result = &Apache::lonnet::put('environment',
                   5827:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   5828: 
1.339     banghart 5829:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   5830:         }
1.359     banghart 5831:         $r->print(&continue());
1.339     banghart 5832:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 5833:         my $meta_field = $env{'form.fieldname'};
                   5834:         my $display_field = $env{'form.fieldname'};
                   5835:         $meta_field =~ s/\W/_/g;
1.338     banghart 5836:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 5837:         my $put_result = &Apache::lonnet::put('environment',
                   5838:                             {'metadata.'.$meta_field.'.values'=>"",
                   5839:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   5840:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 5841:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   5842:         $r->print(&continue());
1.335     banghart 5843:     } else {
1.357     raeburn  5844:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 5845:         if ($fields) {
                   5846:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   5847:             $r->print('<form method="post" action="">');
                   5848:             foreach my $key(keys(%$fields)) {
1.581   ! raeburn  5849:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 5850:             }
                   5851:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   5852:             $r->print('</form>');
                   5853:         }
1.581   ! raeburn  5854:         $r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.'.
        !          5855:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 5856:         $r->print('<input type="text" name="fieldname" /><br />');
                   5857:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.581   ! raeburn  5858:         $r->print('</form>');
1.334     banghart 5859:     }
1.507     www      5860:     &endSettingsScreen($r);
1.334     banghart 5861: }
1.416     jms      5862: 
                   5863: 
                   5864: 
1.560     damieng  5865: # Display or save portfolio metadata.
1.563     damieng  5866: #
                   5867: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 5868: sub setrestrictmeta {
1.240     banghart 5869:     my ($r)=@_;
1.242     banghart 5870:     my $next_meta;
1.244     banghart 5871:     my $output;
1.245     banghart 5872:     my $item_num;
1.246     banghart 5873:     my $put_result;
1.414     droeschl 5874:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 5875:         text=>"Restrict Metadata"});
1.280     albertel 5876:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 5877:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 5878:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5879:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5880:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5881:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 5882:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 5883:     my $save_field = '';
1.259     banghart 5884:     if ($env{'form.restrictmeta'}) {
1.254     banghart 5885:         foreach my $field (sort(keys(%env))) {
1.252     banghart 5886:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 5887:                 my $options;
1.252     banghart 5888:                 my $meta_field = $1;
                   5889:                 my $meta_key = $2;
1.253     banghart 5890:                 if ($save_field ne $meta_field) {
1.252     banghart 5891:                     $save_field = $meta_field;
1.473     amueller 5892:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   5893:                         $options.='stuadd,';
                   5894:                     }
                   5895:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   5896:                         $options.='choices,';
                   5897:                     }
                   5898:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   5899:                         $options.='onlyone,';
                   5900:                     }
                   5901:                     if ($env{'form.'.$meta_field.'_active'}) {
                   5902:                         $options.='active,';
                   5903:                     }
                   5904:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   5905:                         $options.='deleted,';
                   5906:                     }
1.259     banghart 5907:                     my $name = $save_field;
1.560     damieng  5908:                     $put_result = &Apache::lonnet::put('environment',
                   5909:                         {'metadata.'.$meta_field.'.options'=>$options,
                   5910:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   5911:                         },$dom,$crs);
1.252     banghart 5912:                 }
                   5913:             }
                   5914:         }
                   5915:     }
1.296     albertel 5916:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 5917:                        {'freshen_cache' => 1});
1.335     banghart 5918:     # Get the default metadata fields
1.258     albertel 5919:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 5920:     # Now get possible added metadata fields
1.357     raeburn  5921:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 5922:     my $row_alt = 1;
1.347     banghart 5923:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 5924:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 5925:         if ($field ne 'courserestricted') {
1.346     banghart 5926:             $row_alt = $row_alt ? 0 : 1;
1.560     damieng  5927:             $output.= &output_row($r, $field, $metadata_fields{$field});
                   5928:         }
1.255     banghart 5929:     }
1.351     banghart 5930:     my $buttons = (<<ENDButtons);
                   5931:         <input type="submit" name="restrictmeta" value="Save" />
                   5932:         </form><br />
                   5933:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   5934:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   5935:         </form>
                   5936:         <br />
                   5937:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   5938:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   5939: ENDButtons
1.337     banghart 5940:     my $added_flag = 1;
1.335     banghart 5941:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 5942:         $row_alt = $row_alt ? 0 : 1;
1.563     damieng  5943:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters
1.335     banghart 5944:     }
1.347     banghart 5945:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   5946:     $r->print(<<ENDenv);
1.259     banghart 5947:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 5948:         $output
1.351     banghart 5949:         $buttons
1.340     banghart 5950:         </form>
1.244     banghart 5951: ENDenv
1.507     www      5952:     &endSettingsScreen($r);
1.280     albertel 5953:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 5954:     return 'ok';
                   5955: }
1.416     jms      5956: 
                   5957: 
1.563     damieng  5958: # Returns metadata fields that have been manually added.
                   5959: #
                   5960: # @param {string} $cid - course id
                   5961: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 5962: sub get_added_meta_fieldnames {
1.357     raeburn  5963:     my ($cid) = @_;
1.335     banghart 5964:     my %fields;
                   5965:     foreach my $key(%env) {
1.357     raeburn  5966:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 5967:             my $field_name = $1;
                   5968:             my ($display_field_name) = $env{$key};
                   5969:             $fields{$field_name} = $display_field_name;
                   5970:         }
                   5971:     }
                   5972:     return \%fields;
                   5973: }
1.416     jms      5974: 
                   5975: 
1.563     damieng  5976: # Returns metadata fields that have been manually added and deleted.
                   5977: #
                   5978: # @param {string} $cid - course id
                   5979: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 5980: sub get_deleted_meta_fieldnames {
1.357     raeburn  5981:     my ($cid) = @_;
1.339     banghart 5982:     my %fields;
                   5983:     foreach my $key(%env) {
1.357     raeburn  5984:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 5985:             my $field_name = $1;
                   5986:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   5987:                 my ($display_field_name) = $env{$key};
                   5988:                 $fields{$field_name} = $display_field_name;
                   5989:             }
                   5990:         }
                   5991:     }
                   5992:     return \%fields;
                   5993: }
1.560     damieng  5994: 
                   5995: 
                   5996: ##################################################
                   5997: # PARAMETER SETTINGS DEFAULT ACTIONS
                   5998: ##################################################
                   5999: 
                   6000: # UI to change parameter setting default actions
1.563     damieng  6001: #
                   6002: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6003: sub defaultsetter {
1.280     albertel 6004:     my ($r) = @_;
                   6005: 
1.414     droeschl 6006:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6007:         text=>"Set Defaults"});
1.531     raeburn  6008:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6009:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6010:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6011:     my $start_page =
1.531     raeburn  6012:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6013:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6014:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6015:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6016:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6017: 
1.221     www      6018:     my @ids=();
                   6019:     my %typep=();
                   6020:     my %keyp=();
                   6021:     my %allparms=();
                   6022:     my %allparts=();
                   6023:     my %allmaps=();
                   6024:     my %mapp=();
                   6025:     my %symbp=();
                   6026:     my %maptitles=();
                   6027:     my %uris=();
                   6028:     my %keyorder=&standardkeyorder();
                   6029:     my %defkeytype=();
                   6030: 
1.446     bisitz   6031:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6032:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6033:                 \%keyorder,\%defkeytype);
1.224     www      6034:     if ($env{'form.storerules'}) {
1.560     damieng  6035:         my %newrules=();
                   6036:         my @delrules=();
                   6037:         my %triggers=();
                   6038:         foreach my $key (keys(%env)) {
1.225     albertel 6039:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6040:                 my $tempkey=$1;
                   6041:                 my $action=$env{$key};
1.226     www      6042:                 if ($action) {
1.560     damieng  6043:                     $newrules{$tempkey.'_action'}=$action;
                   6044:                     if ($action ne 'default') {
                   6045:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6046:                         $triggers{$whichparm}.=$tempkey.':';
                   6047:                     }
                   6048:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6049:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6050:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6051:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6052:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6053:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6054:                     } else {
                   6055:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6056:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6057:                     }
                   6058:                 } else {
                   6059:                     push(@delrules,$tempkey.'_action');
                   6060:                     push(@delrules,$tempkey.'_type');
                   6061:                     push(@delrules,$tempkey.'_hours');
                   6062:                     push(@delrules,$tempkey.'_min');
                   6063:                     push(@delrules,$tempkey.'_sec');
                   6064:                     push(@delrules,$tempkey.'_value');
                   6065:                 }
1.473     amueller 6066:             }
                   6067:         }
1.560     damieng  6068:         foreach my $key (keys(%allparms)) {
                   6069:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6070:         }
1.560     damieng  6071:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6072:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6073:         &resetrulescache();
1.224     www      6074:     }
1.227     www      6075:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6076:                        'hours' => 'Hours',
                   6077:                        'min' => 'Minutes',
                   6078:                        'sec' => 'Seconds',
                   6079:                        'yes' => 'Yes',
                   6080:                        'no' => 'No');
1.222     www      6081:     my @standardoptions=('','default');
                   6082:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6083:     my @dateoptions=('','default');
                   6084:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6085:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6086:         unless ($tempkey) { next; }
                   6087:         push @standardoptions,'when_setting_'.$tempkey;
                   6088:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6089:         if (&isdateparm($defkeytype{$tempkey})) {
                   6090:             push @dateoptions,'later_than_'.$tempkey;
                   6091:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6092:             push @dateoptions,'earlier_than_'.$tempkey;
                   6093:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6094:         }
1.222     www      6095:     }
1.563     damieng  6096:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6097:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6098:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6099:           &Apache::loncommon::start_data_table_header_row().
                   6100:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6101:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6102:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6103:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6104:         unless ($tempkey) { next; }
                   6105:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6106:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6107:         my $action=&rulescache($tempkey.'_action');
                   6108:         $r->print('<select name="'.$tempkey.'_action">');
                   6109:         if (&isdateparm($defkeytype{$tempkey})) {
                   6110:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6111:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6112:             $r->print("\n<option value='$dateoptions[$i]'".
                   6113:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6114:                 ">$datedisplay[$i]</option>");
                   6115:             }
                   6116:         } else {
                   6117:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6118:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6119:             $r->print("\n<option value='$standardoptions[$i]'".
                   6120:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6121:                 ">$standarddisplay[$i]</option>");
                   6122:             }
1.473     amueller 6123:         }
1.560     damieng  6124:         $r->print('</select>');
                   6125:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6126:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6127:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6128:         }
1.560     damieng  6129:         $r->print("\n</td><td>\n");
1.222     www      6130: 
1.221     www      6131:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6132:             my $days=&rulescache($tempkey.'_days');
                   6133:             my $hours=&rulescache($tempkey.'_hours');
                   6134:             my $min=&rulescache($tempkey.'_min');
                   6135:             my $sec=&rulescache($tempkey.'_sec');
                   6136:             $r->print(<<ENDINPUTDATE);
                   6137:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6138:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6139:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6140:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6141: ENDINPUTDATE
1.560     damieng  6142:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6143:                 my $yeschecked='';
                   6144:                 my $nochecked='';
                   6145:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6146:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6147: 
                   6148:             $r->print(<<ENDYESNO);
                   6149:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6150:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6151: ENDYESNO
1.221     www      6152:         } else {
1.560     damieng  6153:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6154:         }
1.318     albertel 6155:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6156:     }
1.318     albertel 6157:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6158:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6159:           &mt('Save').'" /></form>'."\n");
                   6160:     &endSettingsScreen($r);
                   6161:     $r->print(&Apache::loncommon::end_page());
1.220     www      6162:     return;
                   6163: }
1.193     albertel 6164: 
1.560     damieng  6165: ##################################################
                   6166: # PARAMETER CHANGES LOG
                   6167: ##################################################
                   6168: 
1.563     damieng  6169: # Returns some info for a parameter log entry.
                   6170: # Returned entries:
                   6171: # $realm - HTML title for the parameter level and resource
                   6172: # $section - parameter section
                   6173: # $name - parameter name
                   6174: # $part - parameter part
                   6175: # $what - $part.'.'.$name
                   6176: # $middle - resource symb ?
                   6177: # $uname - user name (same as given)
                   6178: # $udom - user domain (same as given)
                   6179: # $issection - section or group name
                   6180: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6181: #
                   6182: # @param {string} $key - parameter log key
                   6183: # @param {string} $uname - user name
                   6184: # @param {string} $udom - user domain
                   6185: # @param {boolean} $typeflag - .type log entry
                   6186: # @returns {Array}
1.290     www      6187: sub components {
1.581   ! raeburn  6188:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6189: 
                   6190:     if ($typeflag) {
1.560     damieng  6191:         $key=~s/\.type$//;
1.290     www      6192:     }
1.330     albertel 6193: 
                   6194:     my ($middle,$part,$name)=
1.572     damieng  6195:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6196:     my $issection;
1.330     albertel 6197: 
1.290     www      6198:     my $section=&mt('All Students');
                   6199:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6200:         $issection=$1;
                   6201:         $section=&mt('Group/Section').': '.$issection;
                   6202:         $middle=~s/^\[(.*)\]//;
1.290     www      6203:     }
                   6204:     $middle=~s/\.+$//;
                   6205:     $middle=~s/^\.+//;
1.291     www      6206:     if ($uname) {
1.560     damieng  6207:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6208:         $issection='';
1.291     www      6209:     }
1.316     albertel 6210:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6211:     my $realmdescription=&mt('all resources');
1.556     raeburn  6212:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6213:         my $mapurl = $1;
                   6214:         my $maplevel = $2;
                   6215:         my $leveltitle = &mt('Folder/Map');
                   6216:         if ($maplevel eq 'rec') {
                   6217:             $leveltitle = &mt('Recursive');
                   6218:         }
1.560     damieng  6219:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6220:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6221:             $mapurl.')</span></span>';
                   6222:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6223:     } elsif ($middle) {
                   6224:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6225:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6226:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6227:             ' in '.$map.' id: '.$id.')</span></span>';
                   6228:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6229:     }
1.291     www      6230:     my $what=$part.'.'.$name;
1.330     albertel 6231:     return ($realm,$section,$name,$part,
1.473     amueller 6232:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6233: }
1.293     www      6234: 
1.563     damieng  6235: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6236: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6237: 
1.563     damieng  6238: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6239: sub load_parameter_names {
                   6240:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   6241:     while (my $configline=<$config>) {
1.560     damieng  6242:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6243:         chomp($configline);
                   6244:         my ($short,$plain)=split(/:/,$configline);
                   6245:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6246:         if ($type eq 'display') {
                   6247:             $standard_parms{$name} = $plain;
1.469     raeburn  6248:         } elsif ($type eq 'type') {
1.560     damieng  6249:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6250:         }
1.328     albertel 6251:     }
                   6252:     close($config);
                   6253:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6254:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6255:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6256: }
                   6257: 
1.563     damieng  6258: # Returns a parameter title for standard parameters, the name for others.
                   6259: #
                   6260: # @param {string} $name - parameter name
                   6261: # @returns {string}
1.292     www      6262: sub standard_parameter_names {
                   6263:     my ($name)=@_;
1.328     albertel 6264:     if (!%standard_parms) {
1.560     damieng  6265:         &load_parameter_names();
1.328     albertel 6266:     }
1.292     www      6267:     if ($standard_parms{$name}) {
1.560     damieng  6268:         return $standard_parms{$name};
1.446     bisitz   6269:     } else {
1.560     damieng  6270:         return $name;
1.292     www      6271:     }
                   6272: }
1.290     www      6273: 
1.563     damieng  6274: # Returns a parameter type for standard parameters, undef for others.
                   6275: #
                   6276: # @param {string} $name - parameter name
                   6277: # @returns {string}
1.469     raeburn  6278: sub standard_parameter_types {
                   6279:     my ($name)=@_;
                   6280:     if (!%standard_parms_types) {
                   6281:         &load_parameter_names();
                   6282:     }
                   6283:     if ($standard_parms_types{$name}) {
                   6284:         return $standard_parms_types{$name};
                   6285:     }
                   6286:     return;
                   6287: }
1.309     www      6288: 
1.563     damieng  6289: # Returns a parameter level title (not localized) from the parameter level name.
                   6290: #
                   6291: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6292: # @returns {string}
1.557     raeburn  6293: sub standard_parameter_levels {
                   6294:     my ($name)=@_;
                   6295:     my %levels = (
                   6296:                     'resourcelevel'   => 'a single resource',
                   6297:                     'maplevel'        => 'the enclosing map/folder', 
                   6298:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6299:                     'courselevel'     => 'the general (course) level',
                   6300:                  );
                   6301:     if ($levels{$name}) {
                   6302:         return $levels{$name};
                   6303:     }
                   6304:     return;
                   6305: }
                   6306: 
1.560     damieng  6307: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6308: #
                   6309: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6310: sub parm_change_log {
1.568     raeburn  6311:     my ($r,$parm_permission)=@_;
1.531     raeburn  6312:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6313:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6314:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6315:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6316:     text=>"Parameter Change Log"});
1.522     raeburn  6317:     my $js = '<script type="text/javascript">'."\n".
                   6318:              '// <![CDATA['."\n".
                   6319:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6320:              '// ]]>'."\n".
                   6321:              '</script>'."\n";
                   6322:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6323:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6324:     &startSettingsScreen($r,'parmset',$crstype);
                   6325:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6326: 
1.301     www      6327:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6328: 
1.522     raeburn  6329:     $r->print('<div class="LC_left_float">'.
                   6330:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6331:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6332:                      method="post" name="parameterlog">');
1.446     bisitz   6333: 
1.311     albertel 6334:     my %saveable_parameters = ('show' => 'scalar',);
                   6335:     &Apache::loncommon::store_course_settings('parameter_log',
                   6336:                                               \%saveable_parameters);
                   6337:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6338:                                                 \%saveable_parameters);
1.522     raeburn  6339:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6340:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6341:               '</form></fieldset></div><br clear="all" />');
1.301     www      6342: 
1.568     raeburn  6343:     my $readonly = 1;
                   6344:     if ($parm_permission->{'edit'}) {
                   6345:         undef($readonly);
                   6346:     }
1.531     raeburn  6347:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6348:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6349:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6350:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6351:     unless ($readonly) {
                   6352:         $r->print('<th>'.&mt('Announce').'</th>');
                   6353:     }
                   6354:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6355:     my $shown=0;
1.349     www      6356:     my $folder='';
                   6357:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6358:         my $last='';
                   6359:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6360:                 &GDBM_READER(),0640)) {
                   6361:             $last=$hash{'last_known'};
                   6362:             untie(%hash);
                   6363:         }
                   6364:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6365:     }
                   6366:     foreach my $id (sort {
                   6367:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6368:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6369:                 }
                   6370:                 my $aid = (split('00000',$a))[-1];
                   6371:                 my $bid = (split('00000',$b))[-1];
                   6372:                 return $bid<=>$aid;
1.473     amueller 6373:             } (keys(%parmlog))) {
1.294     www      6374:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6375:         my $count = 0;
                   6376:         my $time =
                   6377:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6378:         my $plainname =
                   6379:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6380:                         $parmlog{$id}{'exe_udom'});
                   6381:         my $about_me_link =
                   6382:             &Apache::loncommon::aboutmewrapper($plainname,
                   6383:                             $parmlog{$id}{'exe_uname'},
                   6384:                             $parmlog{$id}{'exe_udom'});
                   6385:         my $send_msg_link='';
1.568     raeburn  6386:         if ((!$readonly) && 
                   6387:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6388:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6389:             $send_msg_link ='<br />'.
                   6390:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6391:                             $parmlog{$id}{'exe_uname'},
                   6392:                             $parmlog{$id}{'exe_udom'});
                   6393:         }
                   6394:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6395:         my $makenewrow=0;
                   6396:         my %istype=();
                   6397:         my $output;
                   6398:         foreach my $changed (reverse(sort(@changes))) {
                   6399:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6400:             my $typeflag = ($changed =~/\.type$/ &&
                   6401:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6402:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581   ! raeburn  6403:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6404:             if ($env{'request.course.sec'} ne '') {
                   6405:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6406:                 if ($uname ne '') {
                   6407:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6408:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6409:                 }
                   6410:             }
                   6411:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6412:                 if ($folder) {
                   6413:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6414:                 }
                   6415:             }
                   6416:             if ($typeflag) {
                   6417:                 $istype{$parmname}=$value;
                   6418:                 if (!$env{'form.includetypes'}) { next; }
                   6419:             }
                   6420:             $count++;
                   6421:             if ($makenewrow) {
                   6422:                 $output .= $row_start;
                   6423:             } else {
                   6424:                 $makenewrow=1;
                   6425:             }
1.470     raeburn  6426:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6427:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6428:                 &mt($parmitem).'</td><td>'.
                   6429:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6430:             my $stillactive=0;
                   6431:             if ($parmlog{$id}{'delflag'}) {
                   6432:                 $output .= &mt('Deleted');
                   6433:             } else {
                   6434:                 if ($typeflag) {
1.470     raeburn  6435:                     my $parmitem = &standard_parameter_names($value); 
                   6436:                     $parmitem = &mt($parmitem);
1.560     damieng  6437:                     $output .= &mt('Type: [_1]',$parmitem);
                   6438:                 } else {
                   6439:                     my ($level,@all)=&parmval_by_symb($what,$middle,
                   6440:                         &Apache::lonnet::metadata($middle,$what),
                   6441:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6442:                     my $showvalue = $value;
                   6443:                     if ($istype{$parmname} eq '') {
                   6444:                         my $type = &standard_parameter_types($parmname);
                   6445:                         if ($type ne '') {
                   6446:                             if (&isdateparm($type)) {
                   6447:                                 $showvalue =
                   6448:                                     &Apache::lonlocal::locallocaltime($value);
                   6449:                             }
                   6450:                         }
                   6451:                     } else {
1.560     damieng  6452:                         if (&isdateparm($istype{$parmname})) {
                   6453:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6454:                         }
1.469     raeburn  6455:                     }
                   6456:                     $output .= $showvalue;
1.560     damieng  6457:                     if ($value ne $all[$level]) {
                   6458:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6459:                     } else {
                   6460:                         $stillactive=1;
                   6461:                     }
                   6462:                 }
1.473     amueller 6463:             }
1.568     raeburn  6464:             $output .= '</td>';
                   6465: 
                   6466:             unless ($readonly) { 
                   6467:                 $output .= '<td>';
                   6468:                 if ($stillactive) {
                   6469:                     my $parmitem = &standard_parameter_names($parmname);
                   6470:                     $parmitem = &mt($parmitem);
                   6471:                     my $title=&mt('Changed [_1]',$parmitem);
                   6472:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   6473:                         $parmitem,$realmdescription,
                   6474:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   6475:                     if (($uname) && ($udom)) {
                   6476:                         $output .=
                   6477:                         &Apache::loncommon::messagewrapper('Notify User',
                   6478:                                                            $uname,$udom,$title,
                   6479:                                                            $description);
                   6480:                     } else {
                   6481:                         $output .=
                   6482:                             &Apache::lonrss::course_blog_link($id,$title,
                   6483:                                                               $description);
                   6484:                     }
1.560     damieng  6485:                 }
1.568     raeburn  6486:                 $output .= '</td>';
1.560     damieng  6487:             }
1.568     raeburn  6488:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 6489:         }
1.560     damieng  6490:         if ($env{'form.displayfilter'} eq 'containing') {
                   6491:             my $wholeentry=$about_me_link.':'.
                   6492:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6493:             $output;
                   6494:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6495:         }
1.349     www      6496:         if ($count) {
1.560     damieng  6497:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6498:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6499:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6500:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6501:             $send_msg_link.'</td>'.$output);
                   6502:             $shown++;
                   6503:         }
                   6504:         if (!($env{'form.show'} eq &mt('all')
                   6505:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6506:     }
1.301     www      6507:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6508:     &endSettingsScreen($r);
1.284     www      6509:     $r->print(&Apache::loncommon::end_page());
                   6510: }
                   6511: 
1.560     damieng  6512: ##################################################
                   6513: # MISC !
                   6514: ##################################################
                   6515: 
1.563     damieng  6516: # Stores slot information.
1.560     damieng  6517: # Used by table UI
1.563     damieng  6518: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6519: #
                   6520: # @param {string} $slot_name - slot name
                   6521: # @param {string} $cdom - course domain
                   6522: # @param {string} $cnum - course number
                   6523: # @param {string} $symb - resource symb
                   6524: # @param {string} $uname - user name
                   6525: # @param {string} $udom - user domain
                   6526: # @returns {string} - 'ok' or error name
1.437     raeburn  6527: sub update_slots {
                   6528:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6529:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6530:     if (!keys(%slot)) {
                   6531:         return 'error: slot does not exist';
                   6532:     }
                   6533:     my $max=$slot{'maxspace'};
                   6534:     if (!defined($max)) { $max=99999; }
                   6535: 
                   6536:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6537:                                        "^$slot_name\0");
                   6538:     my ($tmp)=%consumed;
                   6539:     if ($tmp=~/^error: 2 / ) {
                   6540:         return 'error: unable to determine current slot status';
                   6541:     }
                   6542:     my $last=0;
                   6543:     foreach my $key (keys(%consumed)) {
                   6544:         my $num=(split('\0',$key))[1];
                   6545:         if ($num > $last) { $last=$num; }
                   6546:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6547:             return 'ok';
                   6548:         }
                   6549:     }
                   6550: 
                   6551:     if (scalar(keys(%consumed)) >= $max) {
                   6552:         return 'error: no space left in slot';
                   6553:     }
                   6554:     my $wanted=$last+1;
                   6555: 
                   6556:     my %reservation=('name'      => $uname.':'.$udom,
                   6557:                      'timestamp' => time,
                   6558:                      'symb'      => $symb);
                   6559: 
                   6560:     my $success=&Apache::lonnet::newput('slot_reservations',
                   6561:                                         {"$slot_name\0$wanted" =>
                   6562:                                              \%reservation},
                   6563:                                         $cdom, $cnum);
1.438     raeburn  6564:     if ($success eq 'ok') {
                   6565:         my %storehash = (
                   6566:                           symb    => $symb,
                   6567:                           slot    => $slot_name,
                   6568:                           action  => 'reserve',
                   6569:                           context => 'parameter',
                   6570:                         );
1.526     raeburn  6571:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6572:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  6573: 
1.526     raeburn  6574:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6575:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  6576:     }
1.437     raeburn  6577:     return $success;
                   6578: }
                   6579: 
1.563     damieng  6580: # Deletes a slot reservation.
1.560     damieng  6581: # Used by table UI
1.563     damieng  6582: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6583: #
                   6584: # @param {string} $slot_name - slot name
                   6585: # @param {string} $cdom - course domain
                   6586: # @param {string} $cnum - course number
                   6587: # @param {string} $uname - user name
                   6588: # @param {string} $udom - user domain
                   6589: # @param {string} $symb - resource symb
                   6590: # @returns {string} - 'ok' or error name
1.437     raeburn  6591: sub delete_slots {
                   6592:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   6593:     my $delresult;
                   6594:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   6595:                                          $cnum, "^$slot_name\0");
                   6596:     if (&Apache::lonnet::error(%consumed)) {
                   6597:         return 'error: unable to determine current slot status';
                   6598:     }
                   6599:     my ($tmp)=%consumed;
                   6600:     if ($tmp=~/^error: 2 /) {
                   6601:         return 'error: unable to determine current slot status';
                   6602:     }
                   6603:     foreach my $key (keys(%consumed)) {
                   6604:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6605:             my $num=(split('\0',$key))[1];
                   6606:             my $entry = $slot_name.'\0'.$num;
                   6607:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   6608:                                               $cdom,$cnum);
                   6609:             if ($delresult eq 'ok') {
                   6610:                 my %storehash = (
                   6611:                                   symb    => $symb,
                   6612:                                   slot    => $slot_name,
                   6613:                                   action  => 'release',
                   6614:                                   context => 'parameter',
                   6615:                                 );
1.526     raeburn  6616:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6617:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  6618:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6619:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  6620:             }
                   6621:         }
                   6622:     }
                   6623:     return $delresult;
                   6624: }
                   6625: 
1.563     damieng  6626: # Returns true if there is a current course.
1.560     damieng  6627: # Used by handler
1.563     damieng  6628: #
                   6629: # @returns {boolean}
1.355     albertel 6630: sub check_for_course_info {
                   6631:     my $navmap = Apache::lonnavmaps::navmap->new();
                   6632:     return 1 if ($navmap);
                   6633:     return 0;
                   6634: }
                   6635: 
1.563     damieng  6636: # Returns the current course host and host LON-CAPA version.
                   6637: #
                   6638: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  6639: sub parameter_release_vars { 
1.504     raeburn  6640:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6641:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   6642:    my $chostname = &Apache::lonnet::hostname($chome);
                   6643:    my ($cmajor,$cminor) = 
                   6644:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   6645:    return ($chostname,$cmajor,$cminor);
                   6646: }
                   6647: 
1.563     damieng  6648: # Checks if the course host version can handle a parameter required version,
                   6649: # and if it does, stores the release needed for the course.
                   6650: #
                   6651: # @param {string} $name - parameter name
                   6652: # @param {string} $value - parameter value
                   6653: # @param {string} $valmatch - name of the test used for checking the value
                   6654: # @param {string} $namematch - name of the test used for checking the name
                   6655: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   6656: # @param {integer} $cmajor - course major version number
                   6657: # @param {integer} $cminor - course minor version number
                   6658: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  6659: sub parameter_releasecheck {
1.557     raeburn  6660:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  6661:     my $needsnewer;
                   6662:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   6663:     if (($cmajor < $needsmajor) || 
                   6664:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   6665:         $needsnewer = 1;
1.557     raeburn  6666:     } elsif ($name) {
                   6667:         if ($valmatch) {
                   6668:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   6669:         } elsif ($value) { 
                   6670:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   6671:         }
                   6672:     } elsif ($namematch) {
                   6673:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  6674:     }
                   6675:     return $needsnewer;
                   6676: }
                   6677: 
1.568     raeburn  6678: sub get_permission {
                   6679:     my %permission;
                   6680:     my $allowed = 0;
                   6681:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   6682:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   6683:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   6684:                   $env{'request.course.sec'}))) {
                   6685:         %permission= (
                   6686:                        'edit'               => 1,
                   6687:                        'set'                => 1,
                   6688:                        'setoverview'        => 1,
                   6689:                        'addmetadata'        => 1,
                   6690:                        'ordermetadata'      => 1,
                   6691:                        'setrestrictmeta'    => 1,
                   6692:                        'newoverview'        => 1,
                   6693:                        'setdefaults'        => 1,
                   6694:                        'settable'           => 1,
                   6695:                        'parameterchangelog' => 1,
                   6696:                        'cleanparameters'    => 1,
                   6697:                        'dateshift1'         => 1,
                   6698:                        'dateshift2'         => 1,
                   6699:                        'helper'             => 1,
                   6700:          );
                   6701:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   6702:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   6703:                   $env{'request.course.sec'}))) {
                   6704:         %permission = (
                   6705:                        'set'                => 1,
                   6706:                        'settable'           => 1,
                   6707:                        'newoverview'        => 1,
                   6708:                        'setoverview'        => 1,
                   6709:                        'parameterchangelog' => 1,
                   6710:                       );
                   6711:     }
                   6712:     foreach my $perm (values(%permission)) {
                   6713:         if ($perm) { $allowed=1; last; }
                   6714:     }
                   6715:     return (\%permission,$allowed);
                   6716: }
                   6717: 
1.560     damieng  6718: ##################################################
                   6719: # HANDLER
                   6720: ##################################################
                   6721: 
                   6722: # Main handler for lonparmset.
                   6723: # Sub called based on request parameters action and command:
                   6724: # no command or action: print_main_menu
                   6725: # command 'set': assessparms (direct access to table mode for a resource)
                   6726: #                (this can also be accessed simply with the symb parameter)
                   6727: # action 'setoverview': overview (display all existing parameter settings)
                   6728: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   6729: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   6730: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   6731: # action 'newoverview': newoverview (overview mode)
                   6732: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   6733: # action 'settable': assessparms (table mode)
                   6734: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   6735: #                              blog postings, user notification changes)
                   6736: # action 'cleanparameters': clean_parameters (unused)
                   6737: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   6738: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      6739: sub handler {
1.43      albertel 6740:     my $r=shift;
1.30      www      6741: 
1.376     albertel 6742:     &reset_caches();
                   6743: 
1.414     droeschl 6744:     &Apache::loncommon::content_type($r,'text/html');
                   6745:     $r->send_http_header;
                   6746:     return OK if $r->header_only;
                   6747: 
1.193     albertel 6748:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 6749:                         ['action','state',
1.205     www      6750:                                              'pres_marker',
                   6751:                                              'pres_value',
1.206     www      6752:                                              'pres_type',
1.506     www      6753:                                              'filter','part',
1.390     www      6754:                                              'udom','uname','symb','serial','timebase']);
1.131     www      6755: 
1.83      bowersj2 6756: 
1.193     albertel 6757:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 6758:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      6759:                         text=>"Content and Problem Settings",
1.473     amueller 6760:                         faq=>10,
                   6761:                         bug=>'Instructor Interface',
1.442     droeschl 6762:                                             help =>
                   6763:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      6764: 
1.30      www      6765: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  6766:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 6767:     my $exists = &check_for_course_info();
                   6768: 
1.568     raeburn  6769:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 6770:         #
                   6771:         # Main switch on form.action and form.state, as appropriate
                   6772:         #
                   6773:         # Check first if coming from someone else headed directly for
                   6774:         #  the table mode
1.568     raeburn  6775:         if (($parm_permission->{'set'}) && 
                   6776:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   6777:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   6778:             &assessparms($r,$parm_permission);
1.193     albertel 6779:         } elsif (! exists($env{'form.action'})) {
                   6780:             &print_main_menu($r,$parm_permission);
1.568     raeburn  6781:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   6782:             &print_main_menu($r,$parm_permission);
1.414     droeschl 6783:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  6784:             &overview($r,$parm_permission);
1.560     damieng  6785:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   6786:             &addmetafield($r);
                   6787:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   6788:             &order_meta_fields($r);
1.414     droeschl 6789:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  6790:             &setrestrictmeta($r);
1.414     droeschl 6791:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  6792:             &newoverview($r,$parm_permission);
1.414     droeschl 6793:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  6794:             &defaultsetter($r);
                   6795:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  6796:             &assessparms($r,$parm_permission);
1.414     droeschl 6797:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  6798:             &parm_change_log($r,$parm_permission);
1.414     droeschl 6799:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  6800:             &clean_parameters($r);
1.414     droeschl 6801:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      6802:             &date_shift_one($r);
1.414     droeschl 6803:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      6804:             &date_shift_two($r);
1.446     bisitz   6805:         }
1.43      albertel 6806:     } else {
1.1       www      6807: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  6808:         if ($exists) {
                   6809:             $env{'user.error.msg'}=
                   6810:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   6811:         } else {
                   6812:             $env{'user.error.msg'}=
                   6813:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   6814:         }
                   6815:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 6816:     }
1.376     albertel 6817:     &reset_caches();
                   6818: 
1.43      albertel 6819:     return OK;
1.1       www      6820: }
                   6821: 
                   6822: 1;
                   6823: __END__
                   6824: 
                   6825: 

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