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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.522.2.25! raeburn     4: # $Id: lonparmset.pm,v 1.522.2.24 2018/09/03 20:23:37 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.522.2.25! raeburn    39: lonparmset provides an interface to setting content parameters in a 
        !            40: course.
1.59      matthew    41: 
                     42: =head1 DESCRIPTION
                     43: 
                     44: This module sets coursewide and assessment parameters.
                     45: 
                     46: =head1 INTERNAL SUBROUTINES
                     47: 
1.416     jms        48: =over
1.59      matthew    49: 
1.416     jms        50: =item parmval()
1.59      matthew    51: 
                     52: Figure out a cascading parameter.
                     53: 
1.71      albertel   54: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   55:          $id   - a bighash Id number
1.71      albertel   56:          $def  - the resource's default value   'stupid emacs
                     57: 
1.269     raeburn    58: Returns:  A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 14 possible levels
1.71      albertel   59: 
1.306     albertel   60: 14- General Course
                     61: 13- Map or Folder level in course
1.269     raeburn    62: 12- resource default
                     63: 11- map default
1.306     albertel   64: 10- resource level in course
1.269     raeburn    65: 9 - General for section
                     66: 8 - Map or Folder level for section
                     67: 7 - resource level in section
                     68: 6 - General for group
                     69: 5 - Map or Folder level for group
                     70: 4 - resource level in group
1.71      albertel   71: 3 - General for specific student
1.82      www        72: 2 - Map or Folder level for specific student
1.71      albertel   73: 1 - resource level for specific student
1.2       www        74: 
1.416     jms        75: =item parmval_by_symb()
                     76: 
                     77: =item reset_caches()
                     78: 
                     79: =item cacheparmhash() 
                     80: 
                     81: =item parmhash()
                     82: 
                     83: =item symbcache()
                     84: 
                     85: =item preset_defaults()
                     86: 
                     87: =item date_sanity_info()
                     88: 
                     89: =item storeparm()
                     90: 
                     91: Store a parameter by symb
                     92: 
                     93:     Takes
                     94:     - symb
                     95:     - name of parameter
                     96:     - level
                     97:     - new value
                     98:     - new type
                     99:     - username
                    100:     - userdomain
                    101: 
                    102: =item log_parmset()
                    103: 
                    104: =item storeparm_by_symb_inner()
                    105: 
                    106: =item valout()
                    107: 
                    108: Format a value for output.
                    109: 
                    110: Inputs:  $value, $type, $editable
                    111: 
                    112: Returns: $value, formatted for output.  If $type indicates it is a date,
                    113: localtime($value) is returned.
                    114: $editable will return an icon to click on
                    115: 
                    116: =item plink()
                    117: 
                    118: Produces a link anchor.
                    119: 
                    120: Inputs: $type,$dis,$value,$marker,$return,$call
                    121: 
                    122: Returns: scalar with html code for a link which will envoke the 
                    123: javascript function 'pjump'.
                    124: 
                    125: =item page_js()
                    126: 
                    127: =item startpage()
                    128: 
                    129: =item print_row()
                    130: 
                    131: =item print_td()
                    132: 
1.522.2.25! raeburn   133: =item check_other_groups()
1.416     jms       134: 
                    135: =item parm_control_group()
                    136: 
                    137: =item extractResourceInformation() : 
                    138: 
1.512     foxr      139:  extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416     jms       140: 
1.522.2.11  raeburn   141: Input: See list below
                    142: 
                    143: =over 4
1.416     jms       144: 
1.512     foxr      145: =item * B<env{'user.name'}> : Current username
1.416     jms       146: 
1.512     foxr      147: =item * B<env{'user.domain'}> : Domain of current user.
1.416     jms       148: 
1.522.2.12  raeburn   149: =item * B<env{"request.course.fn"}> : Course
1.416     jms       150: 
1.522.2.11  raeburn   151: =back
                    152: 
                    153: Outputs: See list below
                    154: 
                    155: =over 4
1.416     jms       156: 
1.512     foxr      157: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416     jms       158: 
1.512     foxr      159: =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       160: 
1.512     foxr      161: =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       162: 
1.512     foxr      163: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416     jms       164: 
1.512     foxr      165: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    166: 
                    167: =item * B<allmaps> (out) : hash, ???
1.416     jms       168: 
                    169: =item * B<mapp> : ??
                    170: 
                    171: =item * B<symbp> : hash, id->full sym?
                    172: 
1.512     foxr      173: =item * B<maptitles>
                    174: 
                    175: =item * B<uris>
1.416     jms       176: 
1.512     foxr      177: =item * B<keyorder>
                    178: 
                    179: =item * B<defkeytype>
1.416     jms       180: 
1.522.2.11  raeburn   181: =back
                    182: 
1.416     jms       183: =item isdateparm()
                    184: 
                    185: =item parmmenu()
                    186: 
                    187: =item partmenu()
                    188: 
                    189: =item usermenu()
                    190: 
                    191: =item displaymenu()
                    192: 
                    193: =item mapmenu()
                    194: 
                    195: =item levelmenu()
                    196: 
                    197: =item sectionmenu()
                    198: 
                    199: =item keysplit()
                    200: 
                    201: =item keysinorder()
                    202: 
                    203: =item keysinorder_bytype()
                    204: 
                    205: =item keysindisplayorder()
                    206: 
                    207: =item standardkeyorder()
                    208: 
                    209: =item assessparms() : 
                    210: 
                    211: Show assessment data and parameters.  This is a large routine that should
                    212: be simplified and shortened... someday.
                    213: 
1.513     foxr      214: Inputs: $r - the Apache request object.
                    215:   
1.416     jms       216: Returns: nothing
                    217: 
                    218: Variables used (guessed by Jeremy):
                    219: 
1.522.2.11  raeburn   220: =over
                    221: 
1.416     jms       222: =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.
                    223: 
                    224: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    225: 
                    226: =item * B<@catmarker> contains list of all possible parameters including part #s
                    227: 
                    228: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
                    229: 
                    230: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
                    231:         When storing information, store as part 0
                    232:         When requesting information, request from full part
                    233: 
1.522.2.11  raeburn   234: =back
                    235: 
1.416     jms       236: =item tablestart()
                    237: 
                    238: =item tableend()
                    239: 
                    240: =item extractuser()
                    241: 
                    242: =item parse_listdata_key()
                    243: 
                    244: =item listdata()
                    245: 
                    246: =item date_interval_selector()
                    247: 
                    248: =item get_date_interval_from_form()
                    249: 
                    250: =item default_selector()
                    251: 
                    252: =item string_selector()
                    253: 
                    254: =item dateshift()
                    255: 
                    256: =item newoverview()
                    257: 
                    258: =item secgroup_lister()
                    259: 
                    260: =item overview()
                    261: 
                    262: =item clean_parameters()
                    263: 
                    264: =item date_shift_one()
                    265: 
                    266: =item date_shift_two()
                    267: 
                    268: =item parse_key()
                    269: 
                    270: =item header()
                    271: 
                    272: Output html header for page
                    273: 
                    274: =item print_main_menu()
                    275: 
                    276: =item output_row()
                    277: 
                    278: Set portfolio metadata
                    279: 
                    280: =item order_meta_fields()
                    281: 
                    282: =item addmetafield()
                    283: 
                    284: =item setrestrictmeta()
                    285: 
                    286: =item get_added_meta_fieldnames()
                    287: 
                    288: =item get_deleted_meta_fieldnames()
                    289: 
                    290: =item defaultsetter()
                    291: 
                    292: =item components()
                    293: 
                    294: =item load_parameter_names()
                    295: 
                    296: =item parm_change_log()
                    297: 
                    298: =item handler() : 
                    299: 
1.450     raeburn   300: Main handler.  Calls &assessparms subroutine.
1.416     jms       301: 
                    302: =back
                    303: 
1.59      matthew   304: =cut
                    305: 
1.416     jms       306: ###################################################################
                    307: ###################################################################
                    308: 
                    309: package Apache::lonparmset;
                    310: 
                    311: use strict;
                    312: use Apache::lonnet;
                    313: use Apache::Constants qw(:common :http REDIRECT);
                    314: use Apache::lonhtmlcommon();
                    315: use Apache::loncommon;
                    316: use GDBM_File;
                    317: use Apache::lonhomework;
                    318: use Apache::lonxml;
                    319: use Apache::lonlocal;
                    320: use Apache::lonnavmaps;
                    321: use Apache::longroup;
                    322: use Apache::lonrss;
1.506     www       323: use HTML::Entities;
1.416     jms       324: use LONCAPA qw(:DEFAULT :match);
                    325: 
                    326: 
1.2       www       327: sub parmval {
1.275     raeburn   328:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    329:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    330:                                                            $cgroup,$courseopt);
1.201     www       331: }
                    332: 
                    333: sub parmval_by_symb {
1.275     raeburn   334:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200     www       335: 
1.352     albertel  336:     my $useropt;
                    337:     if ($uname ne '' && $udom ne '') {
1.473     amueller  338:     $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352     albertel  339:     }
1.200     www       340: 
1.8       www       341:     my $result='';
1.44      albertel  342:     my @outpar=();
1.2       www       343: # ----------------------------------------------------- Cascading lookup scheme
1.446     bisitz    344:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  345:     $map = &Apache::lonnet::deversion($map);
1.10      www       346: 
1.201     www       347:     my $symbparm=$symb.'.'.$what;
                    348:     my $mapparm=$map.'___(all).'.$what;
1.10      www       349: 
1.269     raeburn   350:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    351:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    352:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    353: 
1.190     albertel  354:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    355:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    356:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    357: 
                    358:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    359:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    360:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       361: 
1.11      www       362: 
1.182     albertel  363: # --------------------------------------------------------- first, check course
1.11      www       364: 
1.200     www       365:     if (defined($$courseopt{$courselevel})) {
1.473     amueller  366:     $outpar[14]=$$courseopt{$courselevel};
                    367:     $result=14;
1.43      albertel  368:     }
1.11      www       369: 
1.200     www       370:     if (defined($$courseopt{$courselevelm})) {
1.473     amueller  371:     $outpar[13]=$$courseopt{$courselevelm};
                    372:     $result=13;
1.43      albertel  373:     }
1.11      www       374: 
1.182     albertel  375: # ------------------------------------------------------- second, check default
                    376: 
1.269     raeburn   377:     if (defined($def)) { $outpar[12]=$def; $result=12; }
1.182     albertel  378: 
                    379: # ------------------------------------------------------ third, check map parms
                    380: 
1.376     albertel  381:     my $thisparm=&parmhash($symbparm);
1.269     raeburn   382:     if (defined($thisparm)) { $outpar[11]=$thisparm; $result=11; }
1.182     albertel  383: 
1.200     www       384:     if (defined($$courseopt{$courselevelr})) {
1.473     amueller  385:     $outpar[10]=$$courseopt{$courselevelr};
                    386:     $result=10;
1.43      albertel  387:     }
1.11      www       388: 
1.182     albertel  389: # ------------------------------------------------------ fourth, back to course
1.352     albertel  390:     if ($csec ne '') {
1.200     www       391:         if (defined($$courseopt{$seclevel})) {
1.473     amueller  392:         $outpar[9]=$$courseopt{$seclevel};
                    393:         $result=9;
                    394:     }
1.200     www       395:         if (defined($$courseopt{$seclevelm})) {
1.473     amueller  396:         $outpar[8]=$$courseopt{$seclevelm};
                    397:         $result=8;
                    398:     }
1.43      albertel  399: 
1.200     www       400:         if (defined($$courseopt{$seclevelr})) {
1.473     amueller  401:         $outpar[7]=$$courseopt{$seclevelr};
                    402:         $result=7;
                    403:     }
1.43      albertel  404:     }
1.275     raeburn   405: # ------------------------------------------------------ fifth, check course group
1.352     albertel  406:     if ($cgroup ne '') {
1.269     raeburn   407:         if (defined($$courseopt{$grplevel})) {
                    408:             $outpar[6]=$$courseopt{$grplevel};
                    409:             $result=6;
                    410:         }
                    411:         if (defined($$courseopt{$grplevelm})) {
                    412:             $outpar[5]=$$courseopt{$grplevelm};
                    413:             $result=5;
                    414:         }
                    415:         if (defined($$courseopt{$grplevelr})) {
                    416:             $outpar[4]=$$courseopt{$grplevelr};
                    417:             $result=4;
                    418:         }
                    419:     }
1.11      www       420: 
1.182     albertel  421: # ---------------------------------------------------------- fifth, check user
1.11      www       422: 
1.352     albertel  423:     if ($uname ne '') {
1.473     amueller  424:     if (defined($$useropt{$courselevel})) {
                    425:         $outpar[3]=$$useropt{$courselevel};
                    426:         $result=3;
                    427:     }
                    428: 
                    429:     if (defined($$useropt{$courselevelm})) {
                    430:         $outpar[2]=$$useropt{$courselevelm};
                    431:         $result=2;
                    432:     }
                    433: 
                    434:     if (defined($$useropt{$courselevelr})) {
                    435:         $outpar[1]=$$useropt{$courselevelr};
                    436:         $result=1;
                    437:     }
1.43      albertel  438:     }
1.44      albertel  439:     return ($result,@outpar);
1.2       www       440: }
                    441: 
1.198     www       442: 
                    443: 
1.376     albertel  444: # --- Caches local to lonparmset
                    445: 
1.446     bisitz    446: 
1.376     albertel  447: sub reset_caches {
                    448:     &resetparmhash();
                    449:     &resetsymbcache();
                    450:     &resetrulescache();
1.203     www       451: }
                    452: 
1.376     albertel  453: {
                    454:     my $parmhashid;
                    455:     my %parmhash;
                    456:     sub resetparmhash {
1.473     amueller  457:     undef($parmhashid);
                    458:     undef(%parmhash);
1.376     albertel  459:     }
1.446     bisitz    460: 
1.376     albertel  461:     sub cacheparmhash {
1.473     amueller  462:     if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    463:     my %parmhashfile;
                    464:     if (tie(%parmhashfile,'GDBM_File',
                    465:         $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    466:         %parmhash=%parmhashfile;
                    467:         untie(%parmhashfile);
                    468:         $parmhashid=$env{'request.course.fn'};
                    469:     }
1.201     www       470:     }
1.446     bisitz    471: 
1.376     albertel  472:     sub parmhash {
1.473     amueller  473:     my ($id) = @_;
                    474:     &cacheparmhash();
                    475:     return $parmhash{$id};
1.376     albertel  476:     }
                    477:  }
                    478: 
1.446     bisitz    479: {
1.376     albertel  480:     my $symbsid;
                    481:     my %symbs;
                    482:     sub resetsymbcache {
1.473     amueller  483:     undef($symbsid);
                    484:     undef(%symbs);
1.376     albertel  485:     }
1.446     bisitz    486: 
1.376     albertel  487:     sub symbcache {
1.473     amueller  488:     my $id=shift;
                    489:     if ($symbsid ne $env{'request.course.id'}) {
                    490:         undef(%symbs);
                    491:     }
                    492:     if (!$symbs{$id}) {
                    493:         my $navmap = Apache::lonnavmaps::navmap->new();
                    494:         if ($id=~/\./) {
                    495:         my $resource=$navmap->getById($id);
                    496:         $symbs{$id}=$resource->symb();
                    497:         } else {
                    498:         my $resource=$navmap->getByMapPc($id);
                    499:         $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    500:         }
                    501:         $symbsid=$env{'request.course.id'};
                    502:     }
                    503:     return $symbs{$id};
1.201     www       504:     }
1.376     albertel  505:  }
1.201     www       506: 
1.446     bisitz    507: {
1.376     albertel  508:     my $rulesid;
                    509:     my %rules;
                    510:     sub resetrulescache {
1.473     amueller  511:     undef($rulesid);
                    512:     undef(%rules);
1.376     albertel  513:     }
1.446     bisitz    514: 
1.376     albertel  515:     sub rulescache {
1.473     amueller  516:     my $id=shift;
                    517:     if ($rulesid ne $env{'request.course.id'}
                    518:         && !defined($rules{$id})) {
                    519:         my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    520:         my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                    521:         %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
                    522:         $rulesid=$env{'request.course.id'};
                    523:     }
                    524:     return $rules{$id};
1.221     www       525:     }
                    526: }
                    527: 
1.416     jms       528: 
                    529: 
1.229     www       530: sub preset_defaults {
                    531:     my $type=shift;
                    532:     if (&rulescache($type.'_action') eq 'default') {
                    533: # yes, there is something
1.473     amueller  534:     return (&rulescache($type.'_hours'),
                    535:         &rulescache($type.'_min'),
                    536:         &rulescache($type.'_sec'),
                    537:         &rulescache($type.'_value'));
1.229     www       538:     } else {
                    539: # nothing there or something else
1.473     amueller  540:     return ('','','','','');
1.229     www       541:     }
                    542: }
                    543: 
1.416     jms       544: 
                    545: 
1.277     www       546: 
                    547: sub date_sanity_info {
                    548:    my $checkdate=shift;
                    549:    unless ($checkdate) { return ''; }
                    550:    my $result='';
                    551:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    552:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    553:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413     bisitz    554:          $result.='<div class="LC_warning">'
                    555:                  .&mt('After course enrollment end!')
                    556:                  .'</div>';
1.277     www       557:       }
                    558:    }
                    559:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    560:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413     bisitz    561:          $result.='<div class="LC_warning">'
                    562:                  .&mt('Before course enrollment start!')
                    563:                  .'</div>';
1.277     www       564:       }
                    565:    }
1.413     bisitz    566: # Preparation for additional warnings about dates in the past/future.
                    567: # An improved, more context sensitive version is recommended,
                    568: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
                    569: #   if ($checkdate<time) {
                    570: #      $result.='<div class="LC_info">'
                    571: #              .'('.&mt('in the past').')'
                    572: #              .'</div>';
                    573: #      }
                    574: #   if ($checkdate>time) {
                    575: #      $result.='<div class="LC_info">'
                    576: #              .'('.&mt('in the future').')'
                    577: #              .'</div>';
                    578: #      }
1.277     www       579:    return $result;
                    580: }
                    581: ##################################################
1.186     www       582: ##################################################
                    583: #
1.197     www       584: # Store a parameter by ID
1.186     www       585: #
                    586: # Takes
                    587: # - resource id
                    588: # - name of parameter
                    589: # - level
                    590: # - new value
                    591: # - new type
1.187     www       592: # - username
                    593: # - userdomain
                    594: 
1.186     www       595: sub storeparm {
1.269     raeburn   596:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   597:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       598: }
                    599: 
1.226     www       600: my %recstack;
1.197     www       601: sub storeparm_by_symb {
1.275     raeburn   602:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       603:     unless ($recflag) {
                    604: # first time call
1.473     amueller  605:     %recstack=();
                    606:     $recflag=1;
1.226     www       607:     }
                    608: # store parameter
                    609:     &storeparm_by_symb_inner
1.473     amueller  610:     ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.266     www       611: # don't do anything if parameter was reset
                    612:     unless ($nval) { return; }
1.226     www       613:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
                    614: # remember that this was set
                    615:     $recstack{$parm}=1;
                    616: # what does this trigger?
                    617:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
                    618: # don't backfire
                    619:        unless ((!$triggered) || ($recstack{$triggered})) {
1.473     amueller  620:        my $action=&rulescache($triggered.'_action');
                    621:        my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
1.226     www       622: # set triggered parameter on same level
1.473     amueller  623:        my $newspnam=$prefix.$triggered;
                    624:        my $newvalue='';
                    625:        my $active=1;
                    626:        if ($action=~/^when\_setting/) {
1.228     www       627: # are there restrictions?
1.473     amueller  628:            if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    629:            $active=0;
                    630:            foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
                    631:                if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    632:            }
                    633:            }
                    634:            $newvalue=&rulescache($triggered.'_value');
                    635:        } else {
                    636:            my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
                    637:            if ($action=~/^later\_than/) {
                    638:            $newvalue=$nval+$totalsecs;
                    639:            } else {
                    640:            $newvalue=$nval-$totalsecs;
                    641:            }
                    642:        }
                    643:        if ($active) {
                    644:            &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
                    645:                    $uname,$udom,$csec,$recflag,$cgroup);
                    646:        }
1.226     www       647:        }
                    648:     }
                    649:     return '';
                    650: }
                    651: 
1.293     www       652: sub log_parmset {
1.522.2.3  raeburn   653:     return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284     www       654: }
                    655: 
1.226     www       656: sub storeparm_by_symb_inner {
1.197     www       657: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   658:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       659: # ---------------------------------------------------------- Construct prefixes
1.186     www       660:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.446     bisitz    661:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305     albertel  662:     $map = &Apache::lonnet::deversion($map);
                    663: 
1.197     www       664:     my $symbparm=$symb.'.'.$spnam;
                    665:     my $mapparm=$map.'___(all).'.$spnam;
                    666: 
1.269     raeburn   667:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    668:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    669:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    670: 
1.190     albertel  671:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    672:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    673:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446     bisitz    674: 
1.190     albertel  675:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    676:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    677:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446     bisitz    678: 
1.186     www       679:     my $storeunder='';
1.269     raeburn   680:     if (($snum==14) || ($snum==3)) { $storeunder=$courselevel; }
                    681:     if (($snum==13) || ($snum==2)) { $storeunder=$courselevelm; }
                    682:     if (($snum==10) || ($snum==1)) { $storeunder=$courselevelr; }
                    683:     if ($snum==9) { $storeunder=$seclevel; }
                    684:     if ($snum==8) { $storeunder=$seclevelm; }
                    685:     if ($snum==7) { $storeunder=$seclevelr; }
                    686:     if ($snum==6) { $storeunder=$grplevel; }
                    687:     if ($snum==5) { $storeunder=$grplevelm; }
                    688:     if ($snum==4) { $storeunder=$grplevelr; }
                    689: 
1.446     bisitz    690: 
1.186     www       691:     my $delete;
                    692:     if ($nval eq '') { $delete=1;}
                    693:     my %storecontent = ($storeunder         => $nval,
1.473     amueller  694:             $storeunder.'.type' => $ntype);
1.186     www       695:     my $reply='';
                    696:     if ($snum>3) {
                    697: # ---------------------------------------------------------------- Store Course
                    698: #
1.473     amueller  699:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    700:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186     www       701: # Expire sheets
1.473     amueller  702:     &Apache::lonnet::expirespread('','','studentcalc');
                    703:     if (($snum==10) || ($snum==7) || ($snum==4)) {
                    704:         &Apache::lonnet::expirespread('','','assesscalc',$symb);
                    705:     } elsif (($snum==11) || ($snum==8) || ($snum==5)) {
                    706:         &Apache::lonnet::expirespread('','','assesscalc',$map);
                    707:     } else {
                    708:         &Apache::lonnet::expirespread('','','assesscalc');
                    709:     }
1.186     www       710: # Store parameter
1.473     amueller  711:     if ($delete) {
                    712:         $reply=&Apache::lonnet::del
                    713:         ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.290     www       714:             &log_parmset(\%storecontent,1);
1.473     amueller  715:     } else {
                    716:         $reply=&Apache::lonnet::cput
                    717:         ('resourcedata',\%storecontent,$cdom,$cnum);
                    718:         &log_parmset(\%storecontent);
                    719:     }
                    720:     &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       721:     } else {
                    722: # ------------------------------------------------------------------ Store User
                    723: #
                    724: # Expire sheets
1.473     amueller  725:     &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    726:     if ($snum==1) {
                    727:         &Apache::lonnet::expirespread
                    728:         ($uname,$udom,'assesscalc',$symb);
                    729:     } elsif ($snum==2) {
                    730:         &Apache::lonnet::expirespread
                    731:         ($uname,$udom,'assesscalc',$map);
                    732:     } else {
                    733:         &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    734:     }
1.186     www       735: # Store parameter
1.473     amueller  736:     if ($delete) {
                    737:         $reply=&Apache::lonnet::del
                    738:         ('resourcedata',[keys(%storecontent)],$udom,$uname);
                    739:         &log_parmset(\%storecontent,1,$uname,$udom);
                    740:     } else {
                    741:         $reply=&Apache::lonnet::cput
                    742:         ('resourcedata',\%storecontent,$udom,$uname);
                    743:         &log_parmset(\%storecontent,0,$uname,$udom);
                    744:     }
                    745:     &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       746:     }
1.446     bisitz    747: 
1.186     www       748:     if ($reply=~/^error\:(.*)/) {
1.473     amueller  749:     return "<span class=\"LC_error\">Write Error: $1</span>";
1.186     www       750:     }
                    751:     return '';
                    752: }
                    753: 
1.9       www       754: 
                    755: sub valout {
1.320     www       756:     my ($value,$type,$editable)=@_;
1.59      matthew   757:     my $result = '';
                    758:     # Values of zero are valid.
                    759:     if (! $value && $value ne '0') {
1.522.2.4  raeburn   760:         if ($editable) {
                    761:             $result =
                    762:                 '<img src="/res/adm/pages/editmap.png"'
                    763:                .' alt="'.&mt('Change').'"'
1.522.2.8  raeburn   764:                .' title="'.&mt('Change').'" style="border:0;" />';
1.522.2.4  raeburn   765:         } else {
                    766:             $result='&nbsp;';
                    767:         }
1.59      matthew   768:     } else {
1.66      www       769:         if ($type eq 'date_interval') {
                    770:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
1.413     bisitz    771:             my @timer;
1.66      www       772:             $year=$year-70;
                    773:             $mday--;
                    774:             if ($year) {
1.413     bisitz    775: #               $result.=&mt('[quant,_1,yr]',$year).' ';
                    776:                 push(@timer,&mt('[quant,_1,yr]',$year));
1.66      www       777:             }
                    778:             if ($mon) {
1.413     bisitz    779: #               $result.=&mt('[quant,_1,mth]',$mon).' ';
                    780:                 push(@timer,&mt('[quant,_1,mth]',$mon));
1.66      www       781:             }
                    782:             if ($mday) {
1.413     bisitz    783: #               $result.=&mt('[quant,_1,day]',$mday).' ';
                    784:                 push(@timer,&mt('[quant,_1,day]',$mday));
1.66      www       785:             }
                    786:             if ($hour) {
1.413     bisitz    787: #               $result.=&mt('[quant,_1,hr]',$hour).' ';
                    788:                 push(@timer,&mt('[quant,_1,hr]',$hour));
1.66      www       789:             }
                    790:             if ($min) {
1.413     bisitz    791: #               $result.=&mt('[quant,_1,min]',$min).' ';
                    792:                 push(@timer,&mt('[quant,_1,min]',$min));
1.66      www       793:             }
                    794:             if ($sec) {
1.413     bisitz    795: #               $result.=&mt('[quant,_1,sec]',$sec).' ';
                    796:                 push(@timer,&mt('[quant,_1,sec]',$sec));
1.66      www       797:             }
1.413     bisitz    798: #           $result=~s/\s+$//;
                    799:             if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
                    800:                 push(@timer,&mt('[quant,_1,sec]',0));
                    801:             }
                    802:             $result.=join(", ",@timer);
1.213     www       803:         } elsif (&isdateparm($type)) {
1.361     albertel  804:             $result = &Apache::lonlocal::locallocaltime($value).
1.473     amueller  805:         &date_sanity_info($value);
1.59      matthew   806:         } else {
                    807:             $result = $value;
1.517     www       808:             $result=~s/\,/\, /gs;
1.473     amueller  809:         $result = &HTML::Entities::encode($result,'"<>&');
1.59      matthew   810:         }
                    811:     }
                    812:     return $result;
1.9       www       813: }
                    814: 
1.59      matthew   815: 
1.5       www       816: sub plink {
                    817:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       818:     my $winvalue=$value;
                    819:     unless ($winvalue) {
1.473     amueller  820:     if (&isdateparm($type)) {
1.190     albertel  821:             $winvalue=$env{'form.recent_'.$type};
1.23      www       822:         } else {
1.190     albertel  823:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www       824:         }
                    825:     }
1.229     www       826:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                    827:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                    828:     unless (defined($winvalue)) { $winvalue=$val; }
1.378     albertel  829:     my $valout = &valout($value,$type,1);
1.429     raeburn   830:     my $unencmarker = $marker;
1.378     albertel  831:     foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.473     amueller  832:               \$hour, \$min, \$sec) {
                    833:     $$item = &HTML::Entities::encode($$item,'"<>&');
                    834:     $$item =~ s/\'/\\\'/g;
1.378     albertel  835:     }
1.429     raeburn   836:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473     amueller  837:     '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                    838:         .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
                    839:         $valout.'</a></td></tr></table>';
1.5       www       840: }
                    841: 
1.280     albertel  842: sub page_js {
                    843: 
1.81      www       844:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew   845:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel  846: 
                    847:     return(<<ENDJS);
                    848: <script type="text/javascript">
1.454     bisitz    849: // <![CDATA[
1.44      albertel  850: 
1.88      matthew   851:     $pjump_def
1.44      albertel  852: 
                    853:     function psub() {
                    854:         if (document.parmform.pres_marker.value!='') {
                    855:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    856:             var typedef=new Array();
                    857:             typedef=document.parmform.pres_type.value.split('_');
                    858:            if (document.parmform.pres_type.value!='') {
                    859:             if (typedef[0]=='date') {
                    860:                 eval('document.parmform.recent_'+
                    861:                      document.parmform.pres_type.value+
1.473     amueller  862:              '.value=document.parmform.pres_value.value;');
1.44      albertel  863:             } else {
                    864:                 eval('document.parmform.recent_'+typedef[0]+
1.473     amueller  865:              '.value=document.parmform.pres_value.value;');
1.44      albertel  866:             }
1.473     amueller  867:        }
1.44      albertel  868:             document.parmform.submit();
                    869:         } else {
                    870:             document.parmform.pres_value.value='';
                    871:             document.parmform.pres_marker.value='';
                    872:         }
                    873:     }
                    874: 
1.57      albertel  875:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                    876:         var options = "width=" + w + ",height=" + h + ",";
                    877:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                    878:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                    879:         var newWin = window.open(url, wdwName, options);
                    880:         newWin.focus();
                    881:     }
1.454     bisitz    882: // ]]>
1.44      albertel  883: </script>
1.81      www       884: $selscript
1.280     albertel  885: ENDJS
                    886: 
                    887: }
1.507     www       888: 
1.522.2.2  raeburn   889: sub showhide_js {
                    890:     return <<"COURSECONTENTSCRIPT";
                    891: 
                    892: function showHide_courseContent() {
                    893:     var parmlevValue=document.getElementById("parmlev").value;
                    894:     if (parmlevValue == 'general') {
                    895:         document.getElementById('mapmenu').style.display="none";
                    896:     } else {
                    897:         if ((parmlevValue == "full") || (parmlevValue == "map")) {
                    898:             document.getElementById('mapmenu').style.display ="";
                    899:         } else {
                    900:             document.getElementById('mapmenu').style.display="none";
                    901:         }
                    902:     }
                    903:     return;
                    904: }
                    905: 
                    906: COURSECONTENTSCRIPT
                    907: }
                    908: 
1.280     albertel  909: sub startpage {
1.515     raeburn   910:     my ($r,$psymb) = @_;
1.281     albertel  911: 
1.515     raeburn   912:     my %loaditems = (
                    913:                       'onload'   => "group_or_section('cgroup')",
                    914:                     );
                    915:     if (!$psymb) {
1.522.2.2  raeburn   916:         $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515     raeburn   917:     }
1.280     albertel  918: 
1.414     droeschl  919:     if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
1.473     amueller  920:          && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                    921:     &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
                    922:         text=>"Problem Parameters"});
1.414     droeschl  923:     } else {
1.473     amueller  924:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                    925:        text=>"Table Mode",
                    926:        help => 'Course_Setting_Parameters'});
1.414     droeschl  927:     }
1.522.2.2  raeburn   928:     my $js = &page_js().'
                    929: <script type="text/javascript">
                    930: // <![CDATA[
                    931: '.
                    932:             &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
                    933: // ]]>
                    934: </script>
                    935: ';
1.446     bisitz    936:     my $start_page =
1.522.2.2  raeburn   937:     &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
1.473     amueller  938:                        {'add_entries' => \%loaditems,});
1.446     bisitz    939:     my $breadcrumbs =
1.473     amueller  940:     &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506     www       941:     my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
                    942:     my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507     www       943:     $r->print($start_page.$breadcrumbs);
1.280     albertel  944:     $r->print(<<ENDHEAD);
1.193     albertel  945: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419     bisitz    946: <input type="hidden" value="" name="pres_value" />
                    947: <input type="hidden" value="" name="pres_type" />
                    948: <input type="hidden" value="" name="pres_marker" />
                    949: <input type="hidden" value="1" name="prevvisit" />
1.506     www       950: <input type="hidden" value="$escfilter" name="filter" />
                    951: <input type="hidden" value="$escpart" name="part" />
1.44      albertel  952: ENDHEAD
                    953: }
                    954: 
1.209     www       955: 
1.44      albertel  956: sub print_row {
1.201     www       957:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.522.2.19  raeburn   958:     $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
                    959:     $readonly)=@_;
1.275     raeburn   960:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    961:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    962:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.66      www       963: # get the values for the parameter in cascading order
                    964: # empty levels will remain empty
1.44      albertel  965:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473     amueller  966:       $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       967: # get the type for the parameters
                    968: # problem: these may not be set for all levels
                    969:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn   970:                                           $$name{$which}.'.type',$rid,
1.473     amueller  971:          $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       972: # cascade down manually
1.182     albertel  973:     my $cascadetype=$$defaulttype{$which};
1.269     raeburn   974:     for (my $i=14;$i>0;$i--) {
1.473     amueller  975:      if ($typeoutpar[$i]) {
1.66      www       976:             $cascadetype=$typeoutpar[$i];
1.473     amueller  977:     } else {
1.66      www       978:             $typeoutpar[$i]=$cascadetype;
                    979:         }
                    980:     }
1.57      albertel  981:     my $parm=$$display{$which};
                    982: 
1.203     www       983:     if ($parmlev eq 'full') {
1.419     bisitz    984:         $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506     www       985:                   .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433     raeburn   986:     } else {
1.57      albertel  987:         $parm=~s|\[.*\]\s||g;
                    988:     }
1.231     www       989:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                    990:     if ($automatic) {
1.473     amueller  991:     $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231     www       992:     }
1.427     bisitz    993:     $r->print('<td>'.$parm.'</td>');
1.446     bisitz    994: 
1.44      albertel  995:     my $thismarker=$which;
                    996:     $thismarker=~s/^parameter\_//;
                    997:     my $mprefix=$rid.'&'.$thismarker.'&';
1.275     raeburn   998:     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
                    999:     my ($othergrp,$grp_parm,$controlgrp);
1.44      albertel 1000: 
1.57      albertel 1001:     if ($parmlev eq 'general') {
                   1002: 
                   1003:         if ($uname) {
1.522.2.19  raeburn  1004:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.269     raeburn  1005:         } elsif ($cgroup) {
1.522.2.19  raeburn  1006:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57      albertel 1007:         } elsif ($csec) {
1.522.2.19  raeburn  1008:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1009:         } else {
1.522.2.19  raeburn  1010:             &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1011:         }
                   1012:     } elsif ($parmlev eq 'map') {
                   1013: 
                   1014:         if ($uname) {
1.522.2.19  raeburn  1015:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.269     raeburn  1016:         } elsif ($cgroup) {
1.522.2.19  raeburn  1017:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57      albertel 1018:         } elsif ($csec) {
1.522.2.19  raeburn  1019:             &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1020:         } else {
1.522.2.19  raeburn  1021:             &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1022:         }
                   1023:     } else {
1.275     raeburn  1024:         if ($uname) {
                   1025:             if (@{$usersgroups} > 1) {
                   1026:                 my ($coursereply,$grp_parm,$controlgrp);
                   1027:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
1.522.2.25! raeburn  1028:                     &&check_other_groups($$part{$which}.'.'.$$name{$which},
1.275     raeburn  1029:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
                   1030:                 if ($coursereply && $result > 3) {
                   1031:                     if (defined($controlgrp)) {
                   1032:                         if ($cgroup ne $controlgrp) {
                   1033:                             $effective_parm = $grp_parm;
                   1034:                             $result = 0;
                   1035:                         }
                   1036:                     }
                   1037:                 }
                   1038:             }
                   1039:         }
1.57      albertel 1040: 
1.522.2.22  raeburn  1041:         &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.57      albertel 1042: 
1.522.2.19  raeburn  1043:     &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1044:     &print_td($r,12,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1045:     &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1046:     &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1047: 
                   1048:     if ($csec) {
1.522.2.19  raeburn  1049:         &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1050:         &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1051:         &print_td($r,7,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1052:     }
1.269     raeburn  1053: 
                   1054:         if ($cgroup) {
1.522.2.21  raeburn  1055:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
                   1056:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
                   1057:             &print_td($r,4,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,$noeditgrp,$readonly);
1.269     raeburn  1058:         }
1.446     bisitz   1059: 
1.473     amueller 1060:     if ($uname) {
1.275     raeburn  1061:             if ($othergrp) {
                   1062:                 $r->print($othergrp);
                   1063:             }
1.522.2.19  raeburn  1064:         &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1065:         &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
                   1066:         &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display,'',$readonly);
1.473     amueller 1067:     }
1.57      albertel 1068: 
                   1069:     } # end of $parmlev if/else
1.419     bisitz   1070:     $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.'</td>');
1.136     albertel 1071: 
1.203     www      1072:     if ($parmlev eq 'full') {
1.136     albertel 1073:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www      1074:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel 1075:         my $sessionvaltype=$typeoutpar[$result];
                   1076:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
1.419     bisitz   1077:         $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.66      www      1078:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel 1079:                   '</font></td>');
1.136     albertel 1080:     }
1.44      albertel 1081:     $r->print('</tr>');
1.57      albertel 1082:     $r->print("\n");
1.44      albertel 1083: }
1.59      matthew  1084: 
1.44      albertel 1085: sub print_td {
1.522.2.19  raeburn  1086:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,$noeditgrp,$readonly)=@_;
1.419     bisitz   1087:     $r->print('<td style="background-color:'.(($result==$which)?'#AAFFAA':$defbg).
                   1088:               ';" align="center">');
1.437     raeburn  1089:     my $nolink = 0;
1.522.2.19  raeburn  1090:     if ($readonly) {
1.437     raeburn  1091:         $nolink = 1;
1.522.2.19  raeburn  1092:     } else {
                   1093:         if ($which == 11 || $which == 12) {
1.522.2.7  raeburn  1094:             $nolink = 1;
1.522.2.24  raeburn  1095:         } elsif (($env{'request.course.sec'} ne '') && ($which > 9)) {
                   1096:             $nolink = 1;
                   1097:         } elsif ($which == 4 || $which ==  5 || $which == 6) {
                   1098:             if ($noeditgrp) {
                   1099:                 $nolink = 1;
                   1100:             }
1.522.2.19  raeburn  1101:         } elsif ($mprefix =~ /availablestudent\&$/) {
                   1102:             if ($which > 3) {
                   1103:                 $nolink = 1;
                   1104:             }
                   1105:         } elsif ($mprefix =~ /examcode\&$/) {
                   1106:             unless ($which == 2) {
                   1107:                 $nolink = 1;
                   1108:             }
1.522.2.7  raeburn  1109:         }
1.437     raeburn  1110:     }
                   1111:     if ($nolink) {
                   1112:         $r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
1.114     www      1113:     } else {
1.437     raeburn  1114:         $r->print(&plink($$typeoutpar[$which],
                   1115:                          $$display{$value},$$outpar[$which],
                   1116:                          $mprefix."$which",'parmform.pres','psub'));
1.114     www      1117:     }
                   1118:     $r->print('</td>'."\n");
1.57      albertel 1119: }
                   1120: 
1.522.2.25! raeburn  1121: sub check_other_groups {
        !          1122:     my ($what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1.275     raeburn  1123:     my $courseid = $env{'request.course.id'};
                   1124:     my $output;
                   1125:     my $symb = &symbcache($rid);
                   1126:     my $symbparm=$symb.'.'.$what;
                   1127:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
                   1128:     my $mapparm=$map.'___(all).'.$what;
                   1129:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
                   1130:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,$what,
                   1131:                                                                    $courseopt);
                   1132:     my $bgcolor = $defbg;
                   1133:     my $grp_parm;
1.446     bisitz   1134:     if (($coursereply) && ($cgroup ne $resultgroup)) {
1.275     raeburn  1135:         if ($result > 3) {
1.419     bisitz   1136:             $bgcolor = '#AAFFAA';
1.275     raeburn  1137:         }
                   1138:         $grp_parm = &valout($coursereply,$resulttype);
1.419     bisitz   1139:         $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275     raeburn  1140:         if ($resultgroup && $resultlevel) {
                   1141:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                   1142:         } else {
                   1143:             $output .= '&nbsp;';
                   1144:         }
                   1145:         $output .= '</td>';
                   1146:     } else {
1.419     bisitz   1147:         $output .= '<td style="background-color:'.$bgcolor.';">&nbsp;</td>';
1.275     raeburn  1148:     }
                   1149:     return ($coursereply,$output,$grp_parm,$resultgroup);
                   1150: }
                   1151: 
                   1152: sub parm_control_group {
                   1153:     my ($courseid,$usersgroups,$symbparm,$mapparm,$what,$courseopt) = @_;
                   1154:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1155:     my $grpfound = 0;
                   1156:     my @levels = ($symbparm,$mapparm,$what);
                   1157:     my @levelnames = ('resource','map/folder','general');
                   1158:     foreach my $group (@{$usersgroups}) {
                   1159:         if ($grpfound) { last; }
                   1160:         for (my $i=0; $i<@levels; $i++) {
                   1161:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                   1162:             if (defined($$courseopt{$item})) {
                   1163:                 $coursereply = $$courseopt{$item};
                   1164:                 $resultitem = $item;
                   1165:                 $resultgroup = $group;
                   1166:                 $resultlevel = $levelnames[$i];
                   1167:                 $resulttype = $$courseopt{$item.'.type'};
                   1168:                 $grpfound = 1;
                   1169:                 last;
                   1170:             }
                   1171:         }
                   1172:     }
                   1173:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                   1174: }
1.201     www      1175: 
1.63      bowersj2 1176: 
                   1177: 
                   1178: sub extractResourceInformation {
                   1179:     my $ids = shift;
                   1180:     my $typep = shift;
                   1181:     my $keyp = shift;
                   1182:     my $allparms = shift;
                   1183:     my $allparts = shift;
                   1184:     my $allmaps = shift;
                   1185:     my $mapp = shift;
                   1186:     my $symbp = shift;
1.82      www      1187:     my $maptitles=shift;
1.196     www      1188:     my $uris=shift;
1.210     www      1189:     my $keyorder=shift;
1.211     www      1190:     my $defkeytype=shift;
1.196     www      1191: 
1.210     www      1192:     my $keyordercnt=100;
1.63      bowersj2 1193: 
1.196     www      1194:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1195:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                   1196:     foreach my $resource (@allres) {
1.480     amueller 1197:         my $id=$resource->id();
1.196     www      1198:         my ($mapid,$resid)=split(/\./,$id);
1.480     amueller 1199:         if ($mapid eq '0') { next; }
                   1200:         $$ids[$#$ids+1]=$id;
                   1201:         my $srcf=$resource->src();
                   1202:         $srcf=~/\.(\w+)$/;
                   1203:         $$typep{$id}=$1;
                   1204:         $$keyp{$id}='';
1.196     www      1205:         $$uris{$id}=$srcf;
1.512     foxr     1206: 
1.480     amueller 1207:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                   1208:             next if ($key!~/^parameter_/);
1.363     albertel 1209: 
1.209     www      1210: # Hidden parameters
1.480     amueller 1211:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209     www      1212: #
                   1213: # allparms is a hash of parameter names
                   1214: #
1.480     amueller 1215:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                   1216:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1217:                 my ($display,$parmdis);
                   1218:                 $display = &standard_parameter_names($name);
                   1219:                 if ($display eq '') {
                   1220:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                   1221:                     $parmdis = $display;
                   1222:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1223:                 } else {
                   1224:                     $parmdis = &mt($display);
                   1225:                 }
                   1226:                 $$allparms{$name}=$parmdis;
                   1227:                 if (ref($defkeytype)) {
                   1228:                     $$defkeytype{$name}=
                   1229:                     &Apache::lonnet::metadata($srcf,$key.'.type');
                   1230:                 }
                   1231:             }
1.363     albertel 1232: 
1.209     www      1233: #
                   1234: # allparts is a hash of all parts
                   1235: #
1.480     amueller 1236:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                   1237:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1238: #
                   1239: # Remember all keys going with this resource
                   1240: #
1.480     amueller 1241:             if ($$keyp{$id}) {
                   1242:                 $$keyp{$id}.=','.$key;
                   1243:             } else {
                   1244:                 $$keyp{$id}=$key;
                   1245:             }   
1.210     www      1246: #
                   1247: # Put in order
1.446     bisitz   1248: #
1.480     amueller 1249:             unless ($$keyorder{$key}) {
                   1250:                 $$keyorder{$key}=$keyordercnt;
                   1251:                 $keyordercnt++;
                   1252:             }
1.473     amueller 1253:         }
                   1254: 
                   1255: 
1.480     amueller 1256:         if (!exists($$mapp{$mapid})) {
                   1257:             $$mapp{$id}=
                   1258:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   1259:             $$mapp{$mapid}=$$mapp{$id};
                   1260:             $$allmaps{$mapid}=$$mapp{$id};
                   1261:             if ($mapid eq '1') {
1.522.2.6  raeburn  1262:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 1263:             } else {
                   1264:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   1265:             }
                   1266:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
                   1267:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.473     amueller 1268:         } else {
1.480     amueller 1269:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 1270:         }
1.480     amueller 1271:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 1272:     }
                   1273: }
                   1274: 
1.208     www      1275: 
                   1276: 
1.213     www      1277: sub isdateparm {
                   1278:     my $type=shift;
                   1279:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1280: }
                   1281: 
1.468     amueller 1282: #
1.501     bisitz   1283: # parmmenu displays a list of the selected parameters.
                   1284: # It also offers a link to show/hide the complete parameter list
                   1285: # from which you can select all desired parameters.
1.468     amueller 1286: #
1.208     www      1287: sub parmmenu {
1.522.2.25! raeburn  1288:     my ($r)=@_;
1.208     www      1289:     $r->print(<<ENDSCRIPT);
                   1290: <script type="text/javascript">
1.454     bisitz   1291: // <![CDATA[
1.208     www      1292:     function checkall(value, checkName) {
1.453     schualex 1293: 
                   1294:         var li = "_li";
                   1295:         var displayOverview = "";
                   1296:         
                   1297:         if (value == false) {
                   1298:             displayOverview = "none"
                   1299:         }
                   1300: 
1.473     amueller 1301:     for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      1302:             ele = document.forms.parmform.elements[i];
                   1303:             if (ele.name == checkName) {
                   1304:                 document.forms.parmform.elements[i].checked=value;
                   1305:             }
                   1306:         }
                   1307:     }
1.210     www      1308: 
                   1309:     function checkthis(thisvalue, checkName) {
1.458     schualex 1310: 
                   1311: 
1.473     amueller 1312:     for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      1313:             ele = document.forms.parmform.elements[i];
                   1314:             if (ele.name == checkName) {
1.473     amueller 1315:         if (ele.value == thisvalue) {
                   1316:             document.forms.parmform.elements[i].checked=true;
                   1317:         }
1.210     www      1318:             }
                   1319:         }
                   1320:     }
                   1321: 
                   1322:     function checkdates() {
1.473     amueller 1323:     checkthis('duedate','pscat');
                   1324:      checkthis('opendate','pscat');
                   1325:     checkthis('answerdate','pscat');
1.218     www      1326:     }
                   1327: 
                   1328:     function checkdisset() {
1.521     raeburn  1329:      checkthis('discussend','pscat');
1.473     amueller 1330:      checkthis('discusshide','pscat');
1.521     raeburn  1331:      checkthis('discussvote','pscat');
1.218     www      1332:     }
                   1333: 
                   1334:     function checkcontdates() {
1.473     amueller 1335:     checkthis('contentopen','pscat');
                   1336:      checkthis('contentclose','pscat');
1.218     www      1337:     }
1.446     bisitz   1338: 
1.210     www      1339:     function checkvisi() {
1.473     amueller 1340:     checkthis('hiddenresource','pscat');
                   1341:      checkthis('encrypturl','pscat');
                   1342:     checkthis('problemstatus','pscat');
                   1343:     checkthis('contentopen','pscat');
                   1344:     checkthis('opendate','pscat');
1.210     www      1345:     }
                   1346: 
                   1347:     function checkparts() {
1.473     amueller 1348:     checkthis('hiddenparts','pscat');
                   1349:     checkthis('display','pscat');
                   1350:     checkthis('ordered','pscat');
1.210     www      1351:     }
                   1352: 
                   1353:     function checkstandard() {
                   1354:         checkall(false,'pscat');
1.473     amueller 1355:     checkdates();
                   1356:     checkthis('weight','pscat');
                   1357:     checkthis('maxtries','pscat');
1.501     bisitz   1358:     checkthis('type','pscat');
                   1359:     checkthis('problemstatus','pscat');
1.210     www      1360:     }
                   1361: 
1.454     bisitz   1362: // ]]>
1.208     www      1363: </script>
                   1364: ENDSCRIPT
1.453     schualex 1365: 
1.491     bisitz   1366:     $r->print('<hr />');
1.522.2.25! raeburn  1367:     &shortCuts($r);
1.491     bisitz   1368:     $r->print('<hr />');
1.453     schualex 1369: }
1.465     amueller 1370: # return a hash
                   1371: sub categories {
                   1372:     return ('time_settings' => 'Time Settings',
                   1373:     'grading' => 'Grading',
                   1374:     'tries' => 'Tries',
                   1375:     'problem_appearance' => 'Problem Appearance',
                   1376:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   1377:     'hiding' => 'Hiding',
                   1378:     'high_level_randomization' => 'High Level Randomization',
                   1379:     'slots' => 'Slots',
                   1380:     'file_submission' => 'File Submission',
                   1381:     'misc' => 'Miscellaneous' ); 
                   1382: }
                   1383: 
                   1384: # return a hash. Like a look-up table
                   1385: sub lookUpTableParameter {
                   1386:  
                   1387:     return ( 
                   1388:         'opendate' => 'time_settings',
                   1389:         'duedate' => 'time_settings',
                   1390:         'answerdate' => 'time_settings',
                   1391:         'interval' => 'time_settings',
                   1392:         'contentopen' => 'time_settings',
                   1393:         'contentclose' => 'time_settings',
                   1394:         'discussend' => 'time_settings',
1.522.2.15  raeburn  1395: 	'printstartdate' => 'time_settings',
                   1396: 	'printenddate' => 'time_settings',
1.465     amueller 1397:         'weight' => 'grading',
                   1398:         'handgrade' => 'grading',
                   1399:         'maxtries' => 'tries',
                   1400:         'hinttries' => 'tries',
1.503     raeburn  1401:         'randomizeontries' => 'tries',
1.465     amueller 1402:         'type' => 'problem_appearance',
                   1403:         'problemstatus' => 'problem_appearance',
                   1404:         'display' => 'problem_appearance',
                   1405:         'ordered' => 'problem_appearance',
                   1406:         'numbubbles' => 'problem_appearance',
                   1407:         'tol' => 'behaviour_of_input_fields',
                   1408:         'sig' => 'behaviour_of_input_fields',
                   1409:         'turnoffunit' => 'behaviour_of_input_fields',
                   1410:         'hiddenresource' => 'hiding',
                   1411:         'hiddenparts' => 'hiding',
                   1412:         'discusshide' => 'hiding',
                   1413:         'buttonshide' => 'hiding',
                   1414:         'turnoffeditor' => 'hiding',
                   1415:         'encrypturl' => 'hiding',
                   1416:         'randomorder' => 'high_level_randomization',
                   1417:         'randompick' => 'high_level_randomization',
                   1418:         'available' => 'slots',
                   1419:         'useslots' => 'slots',
                   1420:         'availablestudent' => 'slots',
                   1421:         'uploadedfiletypes' => 'file_submission',
                   1422:         'maxfilesize' => 'file_submission',
                   1423:         'cssfile' => 'misc',
                   1424:         'mapalias' => 'misc',
                   1425:         'acc' => 'misc',
                   1426:         'maxcollaborators' => 'misc',
                   1427:         'scoreformat' => 'misc',
1.514     raeburn  1428:         'lenient' => 'grading',
1.519     raeburn  1429:         'retrypartial' => 'tries',
1.521     raeburn  1430:         'discussvote'  => 'misc',
1.522.2.7  raeburn  1431:         'examcode' => 'high_level_randomization',
1.522.2.25! raeburn  1432:     );
1.465     amueller 1433: }
                   1434: 
                   1435: sub whatIsMyCategory {
                   1436:     my $name = shift;
                   1437:     my $catList = shift;
                   1438:     my @list;
                   1439:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   1440:     my $cat = $lookUpList{$name};
                   1441:     if (defined($cat)) {
                   1442:         if (!defined($$catList{$cat})){
                   1443:             push @list, ($name);
                   1444:             $$catList{$cat} = \@list;
                   1445:         } else {
                   1446:             push @{${$catList}{$cat}}, ($name);     
                   1447:         }
                   1448:     } else {
                   1449:         if (!defined($$catList{'misc'})){
                   1450:             push @list, ($name);
                   1451:             $$catList{'misc'} = \@list;
                   1452:         } else {
                   1453:             push @{${$catList}{'misc'}}, ($name);     
                   1454:         }
                   1455:     }        
                   1456: }
                   1457: 
                   1458: sub keysindisplayorderCategory {
                   1459:     my ($name,$keyorder)=@_;
                   1460:     return sort {
1.473     amueller 1461:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 1462:     } ( @{$name});
                   1463: }
                   1464: 
1.467     amueller 1465: sub category_order {
                   1466:     return (
                   1467:         'time_settings' => 1,
                   1468:         'grading' => 2,
                   1469:         'tries' => 3,
                   1470:         'problem_appearance' => 4,
                   1471:         'hiding' => 5,
                   1472:         'behaviour_of_input_fields' => 6,
                   1473:         'high_level_randomization'  => 7,
                   1474:         'slots' => 8,
                   1475:         'file_submission' => 9,
                   1476:         'misc' => 10
                   1477:     );
                   1478: 
                   1479: }
1.453     schualex 1480: 
                   1481: sub parmboxes {
                   1482:     my ($r,$allparms,$pscat,$keyorder)=@_;
                   1483:     my $tempkey;
1.465     amueller 1484:     my $tempparameter;
                   1485:     my %categories = &categories;
1.467     amueller 1486:     my %category_order = &category_order();
1.465     amueller 1487:     my %categoryList = (
                   1488:         'time_settings' => [],
                   1489:         'grading' => [],
                   1490:         'tries' => [],
                   1491:         'problem_appearance' => [],
                   1492:         'behaviour_of_input_fields' => [],
                   1493:         'hiding' => [],
                   1494:         'high_level_randomization' => [],
                   1495:         'slots' => [],
                   1496:         'file_submission' => [],
                   1497:         'misc' => [],
1.489     bisitz   1498:     );
1.510     www      1499: 
1.465     amueller 1500:     foreach $tempparameter (keys %$allparms) {
                   1501:         &whatIsMyCategory($tempparameter, \%categoryList);
                   1502:     }
1.453     schualex 1503:     #part to print the parm-list
1.510     www      1504:     $r->print('<div class="LC_columnSection">'."\n");
1.453     schualex 1505: 
1.465     amueller 1506:     #Print parameters
1.467     amueller 1507:     for my $key (sort { $category_order{$a} <=> $category_order{$b} } keys %categoryList) {
1.522.2.8  raeburn  1508:         next if(@{$categoryList{$key}} == 0);
                   1509:         $r->print('<div class="LC_Box LC_400Box">'
                   1510:                   .'<h4 class="LC_hcell">'
                   1511:                   .&mt($categories{$key})
                   1512:                   .'</h4>'."\n");
                   1513:         foreach $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.522.2.25! raeburn  1514:             next if ($tempkey eq '');
1.522.2.8  raeburn  1515:             $r->print('<span class="LC_nobreak">'
                   1516:                      .'<label><input type="checkbox" name="pscat" '
                   1517:                      .'value="'.$tempkey.'" ');
                   1518:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   1519:                 $r->print(' checked="checked"');
                   1520:             }
                   1521:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 1522:                                                       : $tempkey)
1.522.2.8  raeburn  1523:                      .'</label></span><br />'."\n");
1.465     amueller 1524:         }
1.522.2.9  raeburn  1525:         $r->print("</div>\n");
1.465     amueller 1526:     }
1.453     schualex 1527: 
1.510     www      1528:     $r->print("</div>\n");
1.453     schualex 1529: }
1.468     amueller 1530: #
                   1531: # This function offers some links on the parameter section to get with one click a group a parameters
                   1532: #
1.453     schualex 1533: sub shortCuts {
1.522.2.25! raeburn  1534:     my ($r)=@_;
1.453     schualex 1535: 
1.491     bisitz   1536:     # Parameter Selection
                   1537:     $r->print(
                   1538:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   1539:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1540:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   1541:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1542:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   1543:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1544:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   1545:        .&Apache::lonhtmlcommon::end_funclist()
                   1546:     );
                   1547: 
                   1548:     # Add Selection for...
                   1549:     $r->print(
                   1550:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   1551:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1552:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   1553:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1554:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   1555:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1556:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   1557:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1558:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   1559:        .&Apache::lonhtmlcommon::add_item_funclist(
                   1560:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   1561:        .&Apache::lonhtmlcommon::end_funclist()
                   1562:     );
1.208     www      1563: }
                   1564: 
1.209     www      1565: sub partmenu {
1.446     bisitz   1566:     my ($r,$allparts,$psprt)=@_;
1.522.2.2  raeburn  1567:     my $selsize = 1+scalar(keys(%{$allparts}));
                   1568:     if ($selsize > 8) {
                   1569:         $selsize = 8;
                   1570:     }
1.446     bisitz   1571: 
1.522.2.2  raeburn  1572:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      1573:     $r->print('<option value="all"');
1.401     bisitz   1574:     $r->print(' selected="selected"') unless (@{$psprt});
1.208     www      1575:     $r->print('>'.&mt('All Parts').'</option>');
                   1576:     my %temphash=();
                   1577:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 1578:     foreach my $tempkey (sort {
1.473     amueller 1579:     if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
1.234     albertel 1580:     } keys(%{$allparts})) {
1.473     amueller 1581:     unless ($tempkey =~ /\./) {
                   1582:         $r->print('<option value="'.$tempkey.'"');
                   1583:         if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   1584:         $r->print(' selected="selected"');
                   1585:         }
                   1586:         $r->print('>'.$$allparts{$tempkey}.'</option>');
                   1587:     }
1.208     www      1588:     }
1.446     bisitz   1589:     $r->print('</select>');
1.209     www      1590: }
                   1591: 
                   1592: sub usermenu {
1.522.2.24  raeburn  1593:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      1594:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   1595:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   1596:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   1597: 
1.209     www      1598:     my $sections='';
1.300     albertel 1599:     my %sectionhash = &Apache::loncommon::get_sections();
                   1600: 
1.269     raeburn  1601:     my $groups;
1.522.2.24  raeburn  1602:     my %grouphash;
                   1603:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   1604:         %grouphash = &Apache::longroup::coursegroups();
                   1605:     } elsif ($env{'request.course.groups'} ne '') {
                   1606:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
                   1607:     }
1.299     albertel 1608: 
1.412     bisitz   1609:     my $g_s_header='';
                   1610:     my $g_s_footer='';
1.446     bisitz   1611: 
1.522.2.24  raeburn  1612:     my $currsec = $env{'request.course.sec'};
                   1613:     if ($currsec) {
                   1614:         $sections=&mt('Section:').' '.$currsec;
                   1615:         if (%grouphash) {
                   1616:             $sections .= ';'.('&nbsp;' x2);
                   1617:         }
                   1618:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   1619:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 1620:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  1621:             $sections .= qq| onchange="group_or_section('csec')" |;
                   1622:         }
                   1623:         $sections .= '>';
1.473     amueller 1624:     foreach my $section ('',sort keys %sectionhash) {
                   1625:         $sections.='<option value="'.$section.'" '.
                   1626:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  1627:                                                               '</option>';
1.209     www      1628:         }
                   1629:         $sections.='</select>';
1.269     raeburn  1630:     }
1.412     bisitz   1631: 
1.522.2.24  raeburn  1632:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   1633:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  1634:         $sections .= qq|
                   1635: <script type="text/javascript">
1.454     bisitz   1636: // <![CDATA[
1.269     raeburn  1637: function group_or_section(caller) {
                   1638:    if (caller == "cgroup") {
                   1639:        if (document.parmform.cgroup.selectedIndex != 0) {
                   1640:            document.parmform.csec.selectedIndex = 0;
                   1641:        }
                   1642:    } else {
                   1643:        if (document.parmform.csec.selectedIndex != 0) {
                   1644:            document.parmform.cgroup.selectedIndex = 0;
                   1645:        }
                   1646:    }
                   1647: }
1.454     bisitz   1648: // ]]>
1.269     raeburn  1649: </script>
                   1650: |;
1.522.2.24  raeburn  1651:     } elsif ($currsec eq '') {
1.269     raeburn  1652:         $sections .= qq|
                   1653: <script type="text/javascript">
1.454     bisitz   1654: // <![CDATA[
1.269     raeburn  1655: function group_or_section(caller) {
                   1656:     return;
                   1657: }
1.454     bisitz   1658: // ]]>
1.269     raeburn  1659: </script>
                   1660: |;
1.446     bisitz   1661:     }
1.299     albertel 1662: 
                   1663:     if (%grouphash) {
1.412     bisitz   1664:         $groups=&mt('Group:').' <select name="cgroup"';
1.522.2.24  raeburn  1665:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  1666:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   1667:         }
                   1668:         $groups .= '>';
1.275     raeburn  1669:         foreach my $grp ('',sort keys %grouphash) {
                   1670:             $groups.='<option value="'.$grp.'" ';
                   1671:             if ($grp eq $cgroup) {
                   1672:                 unless ((defined($uname)) && ($grp eq '')) {
                   1673:                     $groups .=  'selected="selected" ';
                   1674:                 }
                   1675:             } elsif (!defined($cgroup)) {
                   1676:                 if (@{$usersgroups} == 1) {
                   1677:                     if ($grp eq $$usersgroups[0]) {
                   1678:                         $groups .=  'selected="selected" ';
                   1679:                     }
                   1680:                 }
                   1681:             }
                   1682:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  1683:         }
                   1684:         $groups.='</select>';
                   1685:     }
1.412     bisitz   1686: 
1.445     neumanie 1687:     if (%sectionhash || %grouphash) {
1.446     bisitz   1688:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   1689:         $r->print($sections.$groups);
1.448     bisitz   1690:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.445     neumanie 1691:     }
1.446     bisitz   1692: 
                   1693:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 1694:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   1695:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   1696:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   1697:                  ,$chooseopt));
1.209     www      1698: }
                   1699: 
1.468     amueller 1700: #
                   1701: # This function shows on table Mode the available Parameters for the selected Resources
                   1702: #
1.209     www      1703: sub displaymenu {
1.522.2.25! raeburn  1704:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      1705: 
1.445     neumanie 1706:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      1707:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   1708: 
1.522.2.25! raeburn  1709:     &parmmenu($r);
1.522.2.8  raeburn  1710:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      1711:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   1712:     $r->print(&Apache::loncommon::end_scrollbox());
                   1713: 
                   1714:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 1715:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      1716:  
1.209     www      1717: }
                   1718: 
1.445     neumanie 1719: sub mapmenu {
1.499     raeburn  1720:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 1721:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 1722:     my $navmap = Apache::lonnavmaps::navmap->new();
                   1723:     my $tree=[];
                   1724:     my $treeinfo={};
                   1725:     if (defined($navmap)) {
1.499     raeburn  1726:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 1727:         my $curRes;
                   1728:         my $depth = 0;
1.468     amueller 1729:         my %parent = ();
                   1730:         my $startcount = 5;
                   1731:         my $lastcontainer = $startcount;
                   1732: # preparing what is to show ...
1.461     neumanie 1733:         while ($curRes = $it->next()) {
                   1734:             if ($curRes == $it->BEGIN_MAP()) {
                   1735:                 $depth++;
1.468     amueller 1736:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 1737:             }
                   1738:             if ($curRes == $it->END_MAP()) {
                   1739:                 $depth--;
1.468     amueller 1740:                 $lastcontainer = $parent{$depth};
1.461     neumanie 1741:             }
                   1742:             if (ref($curRes)) {
1.468     amueller 1743:                 my $symb = $curRes->symb();
                   1744:                 my $ressymb = $symb;
1.461     neumanie 1745:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   1746:                     my $type = 'sequence';
                   1747:                     if ($curRes->is_page()) {
                   1748:                         $type = 'page';
                   1749:                     }
                   1750:                     my $id= $curRes->id();
1.468     amueller 1751:                     my $srcf = $curRes->src();
                   1752:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   1753:                     if(!exists($treeinfo->{$id})) {
                   1754:                         push(@$tree,$id);
1.473     amueller 1755:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 1756:                         $treeinfo->{$id} = {
1.461     neumanie 1757:                                     depth => $depth,
                   1758:                                     type  => $type,
1.468     amueller 1759:                                     name  => $resource_name,
                   1760:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 1761:                                     };
1.462     neumanie 1762:                     }
1.461     neumanie 1763:                 }
                   1764:             }
                   1765:         }
1.462     neumanie 1766:     }
1.473     amueller 1767: # Show it ...    
1.484     amueller 1768:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 1769:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   1770:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   1771:         my $whitespace =
                   1772:             '<img src="'
                   1773:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   1774:            .'" alt="" />';
                   1775: 
1.498     bisitz   1776:         # Info about selectable folders/maps
                   1777:         $r->print(
                   1778:             '<div class="LC_info">'
1.508     www      1779:            .&mt('You can only select maps and folders which have modifiable settings.')
                   1780:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   1781:            .'</div>'
                   1782:         );
                   1783: 
1.522.2.8  raeburn  1784:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.522.2.2  raeburn  1785:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   1786: 
1.498     bisitz   1787:         # Display row: "All Maps or Folders"
                   1788:         $r->print(
1.522.2.2  raeburn  1789:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   1790:            .'<td>'
                   1791:            .'<label>'
                   1792:            .'<input type="radio" name="pschp"'
1.497     bisitz   1793:         );
                   1794:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   1795:         $r->print(
                   1796:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   1797:            .&mt('All Maps or Folders')
                   1798:            .'</label>'
                   1799:            .'<hr /></td>'
                   1800:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   1801:         );
1.497     bisitz   1802: 
1.522.2.6  raeburn  1803:         # Display row: "Main Content"
1.468     amueller 1804:         if (exists($$allmaps{1})) {
1.498     bisitz   1805:             $r->print(
                   1806:                 &Apache::loncommon::start_data_table_row()
                   1807:                .'<td>'
                   1808:                .'<label>'
                   1809:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 1810:             );
1.497     bisitz   1811:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   1812:             $r->print(
                   1813:                 '/>&nbsp;'.$icon.'&nbsp;'
                   1814:                .$$maptitles{1}
                   1815:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   1816:                .'</label>'
                   1817:                .'</td>'
                   1818:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 1819:             );
                   1820:         }
1.497     bisitz   1821: 
                   1822:         # Display rows for all course maps and folders
1.468     amueller 1823:         foreach my $id (@{$tree}) {
                   1824:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   1825:             # Indentation
1.468     amueller 1826:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   1827:             my $indent;
                   1828:             for (my $i = 0; $i < $depth; $i++) {
                   1829:                 $indent.= $whitespace;
                   1830:             }
1.461     neumanie 1831:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 1832:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 1833:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   1834:             }
1.468     amueller 1835:             my $symb_name = $$symbp{$id};
                   1836:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   1837:             $symb_name = $tail;
1.498     bisitz   1838:             $r->print(
                   1839:                 &Apache::loncommon::start_data_table_row()
                   1840:                .'<td>'
                   1841:                .'<label>'
1.463     bisitz   1842:             );
1.498     bisitz   1843:             # Only offer radio button for folders/maps which can be parameterized
                   1844:             if ($allmaps_inverted{$symb_name}) {
                   1845:                 $r->print(
                   1846:                     '<input type ="radio" name="pschp"'
                   1847:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   1848:                 );
                   1849:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   1850:                 $r->print('/>');
                   1851:             } else {
                   1852:                 $r->print($whitespace);
1.461     neumanie 1853:             }
1.498     bisitz   1854:             $r->print(
                   1855:                 $indent.$icon.'&nbsp;'
                   1856:                .$treeinfo->{$id}->{name}
                   1857:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   1858:                .'</label>'
                   1859:                .'</td>'
                   1860:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   1861:             );
1.461     neumanie 1862:         }
1.497     bisitz   1863: 
1.522.2.2  raeburn  1864:         $r->print(&Apache::loncommon::end_data_table().
                   1865:                   '<br style="line-height:2px;" />'.
                   1866:                   &Apache::loncommon::end_scrollbox());
1.209     www      1867:     }
                   1868: }
                   1869: 
1.482     amueller 1870: # Build up the select Box to choose if your parameter specification should work for the resource, map/folder or the course level
                   1871: # The value of default selection in the select box is set by the value that is given by the argument in $parmlev.
1.209     www      1872: sub levelmenu {
1.446     bisitz   1873:     my ($r,$alllevs,$parmlev)=@_;
                   1874: 
1.445     neumanie 1875:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').&Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 1876:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.209     www      1877:     foreach (reverse sort keys %{$alllevs}) {
1.473     amueller 1878:     $r->print('<option value="'.$$alllevs{$_}.'"');
                   1879:     if ($parmlev eq $$alllevs{$_}) {
                   1880:         $r->print(' selected="selected"');
                   1881:     }
                   1882:     $r->print('>'.&mt($_).'</option>');
1.208     www      1883:     }
1.446     bisitz   1884:     $r->print("</select>");
1.208     www      1885: }
                   1886: 
1.211     www      1887: 
                   1888: sub sectionmenu {
1.522.2.24  raeburn  1889:     my ($selectedsections)=@_;
1.300     albertel 1890:     my %sectionhash = &Apache::loncommon::get_sections();
1.522.2.24  raeburn  1891:     return '' if (!%sectionhash);
1.300     albertel 1892: 
1.522.2.24  raeburn  1893:     my (@possibles,$disabled);
                   1894:     if ($env{'request.course.sec'} ne '') {
                   1895:         @possibles = ($env{'request.course.sec'});
                   1896:         $selectedsections = [$env{'request.course.sec'}];
                   1897:         $disabled = ' disabled="disabled"';
                   1898:     } else {
                   1899:         @possibles = ('all',sort(keys(%sectionhash)));
1.473     amueller 1900:     }
1.522.2.24  raeburn  1901:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
                   1902:     foreach my $s (@possibles) {
                   1903:         $output .= '    <option value="'.$s.'"';
                   1904:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {
                   1905:             $output .= ' selected="selected"';
                   1906:         }
                   1907:         $output .= '>'."$s</option>\n";
1.300     albertel 1908:     }
1.522.2.24  raeburn  1909:     $output .= "</select>\n");
                   1910:     return $output;
1.269     raeburn  1911: }
                   1912: 
                   1913: sub groupmenu {
1.522.2.24  raeburn  1914:     my ($selectedgroups)=@_;
                   1915:     my %grouphash;
                   1916:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   1917:         %grouphash = &Apache::longroup::coursegroups();
                   1918:     } elsif ($env{'request.course.groups'} ne '') {
                   1919:         map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
                   1920:     }
                   1921:     return '' if (!%grouphash);
1.299     albertel 1922: 
1.522.2.24  raeburn  1923:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 1924:     foreach my $group (sort(keys(%grouphash))) {
1.522.2.24  raeburn  1925:         $output .= '    <option value="'.$group.'"';
                   1926:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   1927:             $output .= ' selected="selected"';
1.473     amueller 1928:         }
1.522.2.24  raeburn  1929:         $output .= '>'.$group."</option>\n";
1.473     amueller 1930:     }
1.522.2.24  raeburn  1931:     $output .= "</select>\n";
                   1932:     return $output;
1.211     www      1933: }
                   1934: 
1.210     www      1935: sub keysplit {
                   1936:     my $keyp=shift;
                   1937:     return (split(/\,/,$keyp));
                   1938: }
                   1939: 
                   1940: sub keysinorder {
                   1941:     my ($name,$keyorder)=@_;
                   1942:     return sort {
1.473     amueller 1943:     $$keyorder{$a} <=> $$keyorder{$b};
1.210     www      1944:     } (keys %{$name});
                   1945: }
                   1946: 
1.236     albertel 1947: sub keysinorder_bytype {
                   1948:     my ($name,$keyorder)=@_;
                   1949:     return sort {
1.473     amueller 1950:     my $ta=(split('_',$a))[-1];
                   1951:     my $tb=(split('_',$b))[-1];
                   1952:     if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   1953:         return ($a cmp $b);
                   1954:     }
                   1955:     $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.236     albertel 1956:     } (keys %{$name});
                   1957: }
                   1958: 
1.211     www      1959: sub keysindisplayorder {
                   1960:     my ($name,$keyorder)=@_;
                   1961:     return sort {
1.473     amueller 1962:     $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.211     www      1963:     } (keys %{$name});
                   1964: }
                   1965: 
1.214     www      1966: sub sortmenu {
                   1967:     my ($r,$sortorder)=@_;
1.236     albertel 1968:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      1969:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   1970:        $r->print(' checked="checked"');
1.214     www      1971:     }
                   1972:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 1973:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      1974:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   1975:        $r->print(' checked="checked"');
1.214     www      1976:     }
1.236     albertel 1977:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 1978:           '</label>');
1.214     www      1979: }
                   1980: 
1.211     www      1981: sub standardkeyorder {
                   1982:     return ('parameter_0_opendate' => 1,
1.473     amueller 1983:         'parameter_0_duedate' => 2,
                   1984:         'parameter_0_answerdate' => 3,
                   1985:         'parameter_0_interval' => 4,
                   1986:         'parameter_0_weight' => 5,
                   1987:         'parameter_0_maxtries' => 6,
                   1988:         'parameter_0_hinttries' => 7,
                   1989:         'parameter_0_contentopen' => 8,
                   1990:         'parameter_0_contentclose' => 9,
                   1991:         'parameter_0_type' => 10,
                   1992:         'parameter_0_problemstatus' => 11,
                   1993:         'parameter_0_hiddenresource' => 12,
                   1994:         'parameter_0_hiddenparts' => 13,
                   1995:         'parameter_0_display' => 14,
                   1996:         'parameter_0_ordered' => 15,
                   1997:         'parameter_0_tol' => 16,
                   1998:         'parameter_0_sig' => 17,
                   1999:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2000:         'parameter_0_discussend' => 19,
                   2001:         'parameter_0_discusshide' => 20,
                   2002:         'parameter_0_discussvote' => 21,
1.522.2.15  raeburn  2003: 	'parameter_0_printstartdate'  =>  22,
                   2004: 	'parameter_0_printenddate' =>  23);
1.211     www      2005: }
                   2006: 
1.59      matthew  2007: 
1.30      www      2008: sub assessparms {
1.1       www      2009: 
1.522.2.19  raeburn  2010:     my ($r,$parm_permission) = @_;
1.512     foxr     2011: 
                   2012: 
                   2013: # -------------------------------------------------------- Variable declaration
1.201     www      2014:     my @ids=();
                   2015:     my %symbp=();
                   2016:     my %mapp=();
                   2017:     my %typep=();
                   2018:     my %keyp=();
                   2019:     my %uris=();
                   2020:     my %maptitles=();
1.129     www      2021:     my %allmaps=();
                   2022:     my %alllevs=();
1.57      albertel 2023: 
1.187     www      2024:     my $uname;
                   2025:     my $udom;
                   2026:     my $uhome;
                   2027:     my $csec;
1.269     raeburn  2028:     my $cgroup;
1.275     raeburn  2029:     my @usersgroups = ();
1.446     bisitz   2030: 
1.190     albertel 2031:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2032: 
1.57      albertel 2033:     $alllevs{'Resource Level'}='full';
1.215     www      2034:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2035:     $alllevs{'Course Level'}='general';
                   2036: 
                   2037:     my %allparms;
                   2038:     my %allparts;
1.512     foxr     2039: # ------------------------------------------------------------------------------
                   2040: 
1.210     www      2041: #
                   2042: # Order in which these parameters will be displayed
                   2043: #
1.211     www      2044:     my %keyorder=&standardkeyorder();
                   2045: 
1.512     foxr     2046: #    @ids=();
                   2047: #    %symbp=();       # These seem defined above already.
                   2048: #    %typep=();
1.43      albertel 2049: 
                   2050:     my $message='';
                   2051: 
1.190     albertel 2052:     $csec=$env{'form.csec'};
1.522.2.24  raeburn  2053:     if ($env{'request.course.sec'} ne '') {
                   2054:         $csec = $env{'request.course.sec'};    
                   2055:     }
                   2056: 
                   2057: # Check group privs.
1.269     raeburn  2058:     $cgroup=$env{'form.cgroup'};
1.522.2.20  raeburn  2059:     my $noeditgrp;
                   2060:     if ($cgroup ne '') {
                   2061:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2062:             if (($env{'request.course.groups'} eq '') ||
1.522.2.24  raeburn  2063:                 (!grep(/^\Q$cgroup\E$/,split(/:/,$env{'request.course.groups'})))) {
1.522.2.20  raeburn  2064:                 $noeditgrp = 1;
                   2065:             }
                   2066:         }
                   2067:     }
1.188     www      2068: 
1.190     albertel 2069:     if      ($udom=$env{'form.udom'}) {
                   2070:     } elsif ($udom=$env{'request.role.domain'}) {
                   2071:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2072:     } else {
1.473     amueller 2073:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2074:     }
1.468     amueller 2075:     
1.43      albertel 2076: 
1.134     albertel 2077:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2078:     my $pschp=$env{'form.pschp'};
1.506     www      2079: 
                   2080: 
1.134     albertel 2081:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.522.2.1  raeburn  2082:     if (!@psprt) { $psprt[0]='0'; }
1.506     www      2083:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 2084: 
1.43      albertel 2085:     my $pssymb='';
1.57      albertel 2086:     my $parmlev='';
1.446     bisitz   2087: 
1.190     albertel 2088:     unless ($env{'form.parmlev'}) {
1.57      albertel 2089:         $parmlev = 'map';
                   2090:     } else {
1.190     albertel 2091:         $parmlev = $env{'form.parmlev'};
1.57      albertel 2092:     }
1.26      www      2093: 
1.29      www      2094: # ----------------------------------------------- Was this started from grades?
                   2095: 
1.190     albertel 2096:     if (($env{'form.command'} eq 'set') && ($env{'form.url'})
1.473     amueller 2097:     && (!$env{'form.dis'})) {
                   2098:         my $url=$env{'form.url'};
                   2099:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   2100:         $pssymb=&Apache::lonnet::symbread($url);
                   2101:         if (!@pscat) { @pscat=('all'); }
                   2102:         $pschp='';
1.57      albertel 2103:         $parmlev = 'full';
1.190     albertel 2104:     } elsif ($env{'form.symb'}) {
1.473     amueller 2105:         $pssymb=$env{'form.symb'};
                   2106:         if (!@pscat) { @pscat=('all'); }
                   2107:         $pschp='';
1.57      albertel 2108:         $parmlev = 'full';
1.43      albertel 2109:     } else {
1.473     amueller 2110:         $env{'form.url'}='';
1.43      albertel 2111:     }
                   2112: 
1.190     albertel 2113:     my $id=$env{'form.id'};
1.43      albertel 2114:     if (($id) && ($udom)) {
1.473     amueller 2115:         $uname=(&Apache::lonnet::idget($udom,$id))[1];
                   2116:         if ($uname) {
                   2117:             $id='';
                   2118:         } else {
                   2119:             $message=
                   2120:             '<span class="LC_error">'.&mt("Unknown ID")." '$id' ".
                   2121:             &mt('at domain')." '$udom'</span>";
                   2122:         }
1.43      albertel 2123:     } else {
1.473     amueller 2124:         $uname=$env{'form.uname'};
1.43      albertel 2125:     }
                   2126:     unless ($udom) { $uname=''; }
                   2127:     $uhome='';
                   2128:     if ($uname) {
1.473     amueller 2129:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 2130:         if ($uhome eq 'no_host') {
1.473     amueller 2131:             $message=
                   2132:             '<span class="LC_error">'.&mt("Unknown user")." '$uname' ".
                   2133:             &mt("at domain")." '$udom'</span>";
                   2134:             $uname='';
1.12      www      2135:         } else {
1.473     amueller 2136:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   2137:                           $env{'request.course.id'});
                   2138:             if ($csec eq '-1') {
                   2139:                 $message='<span class="LC_error">'.
                   2140:                 &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                   2141:                 &mt("not in this course")."</span>";
                   2142:                 $uname='';
                   2143:                 $csec=$env{'form.csec'};
1.269     raeburn  2144:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 2145:             } else {
                   2146:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   2147:                   ('firstname','middlename','lastname','generation','id'));
                   2148:                 $message="\n<p>\n".&mt("Full Name").": ".
                   2149:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   2150:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   2151:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 2152:             }
1.297     raeburn  2153:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  2154:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  2155:             if (@usersgroups > 0) {
1.306     albertel 2156:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  2157:                     $cgroup = $usersgroups[0];
1.297     raeburn  2158:                 }
1.269     raeburn  2159:             }
1.12      www      2160:         }
1.43      albertel 2161:     }
1.2       www      2162: 
1.43      albertel 2163:     unless ($csec) { $csec=''; }
1.269     raeburn  2164:     unless ($cgroup) { $cgroup=''; }
1.12      www      2165: 
1.14      www      2166: # --------------------------------------------------------- Get all assessments
1.446     bisitz   2167:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 2168:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   2169:                 \%keyorder);
1.63      bowersj2 2170: 
1.57      albertel 2171:     $mapp{'0.0'} = '';
                   2172:     $symbp{'0.0'} = '';
1.99      albertel 2173: 
1.14      www      2174: # ---------------------------------------------------------- Anything to store?
1.522.2.19  raeburn  2175:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      2176:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   2177:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   2178:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  2179:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2180:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  2181:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   2182:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   2183:         my $totalstored = 0;
1.522.2.16  raeburn  2184:         my $now = time;
1.473     amueller 2185:         for (my $i=0;$i<=$#markers;$i++) {
1.514     raeburn  2186:             my ($needsrelease,$needsnewer,$name);
1.522.2.24  raeburn  2187:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(7|8|9)$/)) {
                   2188:                 next if ($csec ne $env{'request.course.sec'});
                   2189:             }
                   2190:             if ($markers[$i] =~ /\&(6|5|4)$/) {
                   2191:                 next if ($noeditgrp);
                   2192:             }
1.437     raeburn  2193:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3)$/) {
                   2194:                 my (@ok_slots,@fail_slots,@del_slots);
                   2195:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   2196:                 my ($level,@all) =
                   2197:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   2198:                                      $csec,$cgroup,$courseopt);
                   2199:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   2200:                     next if ($slot_name eq '');
                   2201:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   2202:                         push(@ok_slots,$slot_name);
                   2203: 
                   2204:                     } else {
                   2205:                         push(@fail_slots,$slot_name);
                   2206:                     }
                   2207:                 }
                   2208:                 if (@ok_slots) {
                   2209:                     $values[$i] = join(':',@ok_slots);
                   2210:                 } else {
                   2211:                     $values[$i] = '';
                   2212:                 }
                   2213:                 if ($all[$level] ne '') {
                   2214:                     my @existing = split(/:/,$all[$level]);
                   2215:                     foreach my $slot_name (@existing) {
                   2216:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   2217:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   2218:                                 push(@del_slots,$slot_name);
                   2219:                             }
                   2220:                         }
                   2221:                     }
                   2222:                 }
1.522.2.16  raeburn  2223:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate)\&\d+$/) {
1.514     raeburn  2224:                 $name = $1;
1.522.2.7  raeburn  2225:                 my $val = $values[$i];
                   2226:                 if ($name eq 'examcode') {
1.522.2.14  raeburn  2227:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   2228:                         $val = 'valid';
                   2229:                     }
1.522.2.16  raeburn  2230:                 } elsif ($name eq 'printstartdate') {
                   2231:                     if ($val =~ /^\d+$/) {
                   2232:                         if ($val > $now) {
                   2233:                             $val = 'future';
                   2234:                         }
                   2235:                     }
                   2236:                 } elsif ($name eq 'printenddate') {
                   2237:                     if ($val =~ /^\d+$/) {
                   2238:                         if ($val < $now) {
                   2239:                             $val = 'past';
                   2240:                         }
                   2241:                     }
1.522.2.7  raeburn  2242:                 }
1.504     raeburn  2243:                 $needsrelease =
1.522.2.7  raeburn  2244:                     $Apache::lonnet::needsrelease{"parameter:$name:$val"};
1.504     raeburn  2245:                 if ($needsrelease) {
1.505     raeburn  2246:                     unless ($got_chostname) {
1.514     raeburn  2247:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  2248:                         $got_chostname = 1;
                   2249:                     }
1.522.2.7  raeburn  2250:                     $needsnewer = &parameter_releasecheck($name,$val,
1.514     raeburn  2251:                                                           $needsrelease,
                   2252:                                                           $cmajor,$cminor);
1.500     raeburn  2253:                 }
1.437     raeburn  2254:             }
1.504     raeburn  2255:             if ($needsnewer) {
1.514     raeburn  2256:                 $message .= &oldversion_warning($name,$values[$i],$chostname,$cmajor,
1.504     raeburn  2257:                                                 $cminor,$needsrelease);
                   2258:             } else {
                   2259:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   2260:                                      $values[$i],
                   2261:                                      $types[$i],
                   2262:                                      $uname,$udom,$csec,$cgroup);
                   2263:                 $totalstored ++;
                   2264:             }
1.473     amueller 2265:         }
1.68      www      2266: # ---------------------------------------------------------------- Done storing
1.504     raeburn  2267:         if ($totalstored) {
                   2268:             $message.='<p class="LC_warning">'
                   2269:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   2270:                      .&Apache::loncommon::help_open_topic('Caching')
                   2271:                      .'</p>';
                   2272:         }
1.68      www      2273:     }
1.57      albertel 2274: #----------------------------------------------- if all selected, fill in array
1.209     www      2275:     if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
1.501     bisitz   2276:     if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus') };
1.57      albertel 2277:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www      2278: # ------------------------------------------------------------------ Start page
1.63      bowersj2 2279: 
1.515     raeburn  2280:     &startpage($r,$pssymb);
1.57      albertel 2281: 
1.44      albertel 2282:     foreach ('tolerance','date_default','date_start','date_end',
1.473     amueller 2283:         'date_interval','int','float','string') {
                   2284:         $r->print('<input type="hidden" value="'.
                   2285:           &HTML::Entities::encode($env{'form.recent_'.$_},'"&<>').
                   2286:           '" name="recent_'.$_.'" />');
1.44      albertel 2287:     }
1.446     bisitz   2288: 
1.459     bisitz   2289:     # ----- Start Parameter Selection
                   2290: 
                   2291:     # Hide parm selection?
                   2292:     $r->print(<<ENDPARMSELSCRIPT);
                   2293: <script type="text/javascript">
                   2294: // <![CDATA[
                   2295: function parmsel_show() {
                   2296:   document.getElementById('parmsel').style.display = "";
                   2297:   document.getElementById('parmsellink').style.display = "none";
                   2298: }
                   2299: // ]]>
                   2300: </script>
                   2301: ENDPARMSELSCRIPT
1.474     amueller 2302:     
1.445     neumanie 2303:     if (!$pssymb) {
1.486     www      2304:         my $parmselhiddenstyle=' style="display:none"';
                   2305:         if($env{'form.hideparmsel'} eq 'hidden') {
                   2306:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   2307:         } else  {
                   2308:            $r->print('<div id="parmsel">');
                   2309:         }
                   2310: 
1.491     bisitz   2311:         # Step 1
1.522.2.2  raeburn  2312:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   2313:         $r->print('
1.474     amueller 2314: <script type="text/javascript">
1.522.2.2  raeburn  2315: // <![CDATA['.
                   2316:                  &showhide_js().'
1.474     amueller 2317: // ]]>
                   2318: </script>
1.522.2.2  raeburn  2319: ');
                   2320:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      2321:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   2322:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 2323:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   2324:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   2325:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   2326:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 2327:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2328:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   2329: 
                   2330:         # Step 2
1.522.2.2  raeburn  2331:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.522.2.25! raeburn  2332:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   2333: 
                   2334:         # Step 3
1.522.2.2  raeburn  2335:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      2336:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.522.2.24  raeburn  2337:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      2338:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2339:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   2340: 
                   2341:         # Update Display Button
1.486     www      2342:         $r->print('<p>'
                   2343:              .'<input type="submit" name="dis"'
1.511     www      2344:              .' value="'.&mt('Update Display').'" />'
1.486     www      2345:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   2346:              .'</p>');
                   2347:         $r->print('</div>');
1.491     bisitz   2348: 
1.486     www      2349:         # Offer link to display parameter selection again
                   2350:         $r->print('<p id="parmsellink"');
                   2351:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   2352:            $r->print($parmselhiddenstyle);
                   2353:         }
                   2354:         $r->print('>'
                   2355:              .'<a href="javascript:parmsel_show()">'
                   2356:              .&mt('Change Parameter Selection')
                   2357:              .'</a>'
                   2358:              .'</p>');
1.44      albertel 2359:     } else {
1.515     raeburn  2360:         $r->print();
1.478     amueller 2361:         # parameter screen for a single resource. 
1.486     www      2362:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 2363:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   2364:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   2365:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 2366:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      2367:                   '<br />');
                   2368:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   2369:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.522.2.1  raeburn  2370:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')).
                   2371:                   '<label>'.
                   2372:                   '<input type="checkbox" name="psprt" value="all"'.
                   2373:                   ($env{'form.psprt'}?' checked="checked"':'').' />'.
                   2374:                   &mt('Show all parts').
                   2375:                   '</label></td></tr>');
1.522.2.24  raeburn  2376:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      2377:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   2378:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   2379:         $r->print('<p>'
1.459     bisitz   2380:              .'<input type="submit" name="dis"'
1.511     www      2381:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   2382:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      2383:              .'</p>');
1.459     bisitz   2384:     }
1.478     amueller 2385:     
1.486     www      2386:     # ----- End Parameter Selection
1.57      albertel 2387: 
1.459     bisitz   2388:     # Display Messages
                   2389:     $r->print('<div>'.$message.'</div>');
1.210     www      2390: 
1.57      albertel 2391: 
                   2392:     my @temp_pscat;
                   2393:     map {
                   2394:         my $cat = $_;
                   2395:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   2396:     } @pscat;
                   2397: 
                   2398:     @pscat = @temp_pscat;
                   2399: 
1.209     www      2400:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      2401: # ----------------------------------------------------------------- Start Table
1.57      albertel 2402:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 2403:         my $csuname=$env{'user.name'};
                   2404:         my $csudom=$env{'user.domain'};
1.522.2.19  raeburn  2405:         my $readonly = 1;
                   2406:         if ($parm_permission->{'edit'}) {
                   2407:             undef($readonly);
                   2408:         }
1.57      albertel 2409: 
1.203     www      2410:         if ($parmlev eq 'full') {
1.506     www      2411: #
                   2412: # This produces the cascading table output of parameters
                   2413: #
1.473     amueller 2414:                my $coursespan=$csec?8:5;
                   2415:                my $userspan=3;
                   2416:                if ($cgroup ne '') {
                   2417:                   $coursespan += 3;
                   2418:                }
                   2419: 
1.517     www      2420:                $r->print(&Apache::loncommon::start_data_table());
1.506     www      2421: #
                   2422: # This produces the headers
                   2423: #
1.473     amueller 2424:                $r->print('<tr><td colspan="5"></td>');
                   2425:                $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   2426:                if ($uname) {
                   2427:                 if (@usersgroups > 1) {
                   2428:                        $userspan ++;
                   2429:                    }
                   2430:                    $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   2431:                    $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
                   2432:                }
                   2433:                my %lt=&Apache::lonlocal::texthash(
                   2434:                 'pie'    => "Parameter in Effect",
                   2435:                 'csv'    => "Current Session Value",
1.472     amueller 2436:                 'rl'     => "Resource Level",
1.473     amueller 2437:                 'ic'     => 'in Course',
                   2438:                 'aut'    => "Assessment URL and Title",
                   2439:                 'type'   => 'Type',
                   2440:                 'emof'   => "Enclosing Map or Folder",
                   2441:                 'part'   => 'Part',
1.472     amueller 2442:                 'pn'     => 'Parameter Name',
1.473     amueller 2443:                 'def'    => 'default',
                   2444:                 'femof'  => 'from Enclosing Map or Folder',
                   2445:                 'gen'    => 'general',
                   2446:                 'foremf' => 'for Enclosing Map or Folder',
                   2447:                 'fr'     => 'for Resource'
                   2448:             );
                   2449:                $r->print(<<ENDTABLETWO);
1.419     bisitz   2450: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   2451: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.419     bisitz   2452: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
                   2453: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 2454: 
1.10      www      2455: ENDTABLETWO
1.473     amueller 2456:                if ($csec) {
                   2457:                    $r->print('<th colspan="3">'.
                   2458:                   &mt("in Section")." $csec</th>");
                   2459:                }
                   2460:                if ($cgroup) {
1.419     bisitz   2461:                 $r->print('<th colspan="3">'.
1.472     amueller 2462:                 &mt("in Group")." $cgroup</th>");
1.473     amueller 2463:                }
                   2464:                $r->print(<<ENDTABLEHEADFOUR);
1.133     www      2465: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   2466: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 2467: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   2468: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      2469: ENDTABLEHEADFOUR
1.57      albertel 2470: 
1.473     amueller 2471:                if ($csec) {
                   2472:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2473:                }
                   2474: 
                   2475:                if ($cgroup) {
                   2476:                 $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2477:                }
                   2478: 
                   2479:                if ($uname) {
                   2480:                 if (@usersgroups > 1) {
                   2481:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   2482:                    }
                   2483:                    $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2484:                }
                   2485: 
                   2486:                $r->print('</tr>');
1.506     www      2487: #
                   2488: # Done with the headers
                   2489: # 
1.473     amueller 2490:                my $defbgone='';
                   2491:                my $defbgtwo='';
                   2492:                my $defbgthree = '';
1.57      albertel 2493: 
1.473     amueller 2494:                foreach (@ids) {
1.57      albertel 2495: 
1.473     amueller 2496:                 my $rid=$_;
1.57      albertel 2497:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   2498: 
1.446     bisitz   2499:                 if ((!$pssymb &&
1.473     amueller 2500:                  (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   2501:                 ||
                   2502:                 ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      2503: # ------------------------------------------------------ Entry for one resource
1.473     amueller 2504:                     if ($defbgone eq '#E0E099') {
                   2505:                         $defbgone='#E0E0DD';
1.57      albertel 2506:                     } else {
1.419     bisitz   2507:                         $defbgone='#E0E099';
1.57      albertel 2508:                     }
1.419     bisitz   2509:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 2510:                         $defbgtwo='#FFFFDD';
1.57      albertel 2511:                     } else {
1.473     amueller 2512:                         $defbgtwo='#FFFF99';
1.57      albertel 2513:                     }
1.419     bisitz   2514:                     if ($defbgthree eq '#FFBB99') {
                   2515:                         $defbgthree='#FFBBDD';
1.269     raeburn  2516:                     } else {
1.419     bisitz   2517:                         $defbgthree='#FFBB99';
1.269     raeburn  2518:                     }
                   2519: 
1.57      albertel 2520:                     my $thistitle='';
                   2521:                     my %name=   ();
                   2522:                     undef %name;
                   2523:                     my %part=   ();
                   2524:                     my %display=();
                   2525:                     my %type=   ();
                   2526:                     my %default=();
1.196     www      2527:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2528: 
1.506     www      2529:                     my $filter=$env{'form.filter'};
1.210     www      2530:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2531:                         my $tempkeyp = $_;
                   2532:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.506     www      2533:                           my $parmname=&Apache::lonnet::metadata($uri,$_.'.name');
                   2534: # We may only want certain parameters listed
                   2535:                           if ($filter) {
                   2536:                              unless ($filter=~/\Q$parmname\E/) { next; }
                   2537:                           }
                   2538:                           $name{$_}=$parmname;
1.57      albertel 2539:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
1.506     www      2540: 
1.433     raeburn  2541:                           my $parmdis=&Apache::lonnet::metadata($uri,$_.'.display');
                   2542:                           if ($allparms{$name{$_}} ne '') {
                   2543:                               my $identifier;
                   2544:                               if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2545:                                   $identifier = $1;
                   2546:                               }
                   2547:                               $display{$_} = $allparms{$name{$_}}.$identifier;
                   2548:                           } else {
                   2549:                               $display{$_} = $parmdis;
                   2550:                           }
1.57      albertel 2551:                           unless ($display{$_}) { $display{$_}=''; }
                   2552:                           $display{$_}.=' ('.$name{$_}.')';
                   2553:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   2554:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   2555:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   2556:                         }
                   2557:                     }
                   2558:                     my $totalparms=scalar keys %name;
                   2559:                     if ($totalparms>0) {
1.473     amueller 2560:                            my $firstrow=1;
                   2561:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   2562:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 2563:                              ' rowspan='.$totalparms.
1.419     bisitz   2564:                              '><tt><font size="-1">'.
1.57      albertel 2565:                              join(' / ',split(/\//,$uri)).
                   2566:                              '</font></tt><p><b>'.
1.154     albertel 2567:                              "<a href=\"javascript:openWindow('".
1.473     amueller 2568:                           &Apache::lonnet::clutter($uri).'?symb='.
                   2569:                           &escape($symbp{$rid}).
1.336     albertel 2570:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   2571:                              " target=\"_self\">$title");
1.57      albertel 2572: 
                   2573:                         if ($thistitle) {
1.473     amueller 2574:                             $r->print(' ('.$thistitle.')');
1.57      albertel 2575:                         }
                   2576:                         $r->print('</a></b></td>');
1.419     bisitz   2577:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 2578:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   2579:                                       '</td>');
                   2580: 
1.419     bisitz   2581:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 2582:                                       ' rowspan='.$totalparms.
1.238     www      2583:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.512     foxr     2584:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 2585: 
                   2586:                             unless ($firstrow) {
                   2587:                                 $r->print('<tr>');
                   2588:                             } else {
                   2589:                                 undef $firstrow;
                   2590:                             }
1.201     www      2591:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 2592:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  2593:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.522.2.19  raeburn  2594:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly);
1.57      albertel 2595:                         }
                   2596:                     }
                   2597:                 }
                   2598:             } # end foreach ids
1.43      albertel 2599: # -------------------------------------------------- End entry for one resource
1.517     www      2600:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      2601:         } # end of  full
1.57      albertel 2602: #--------------------------------------------------- Entry for parm level map
                   2603:         if ($parmlev eq 'map') {
1.419     bisitz   2604:             my $defbgone = '#E0E099';
                   2605:             my $defbgtwo = '#FFFF99';
                   2606:             my $defbgthree = '#FFBB99';
1.57      albertel 2607: 
                   2608:             my %maplist;
                   2609: 
                   2610:             if ($pschp eq 'all') {
1.446     bisitz   2611:                 %maplist = %allmaps;
1.57      albertel 2612:             } else {
                   2613:                 %maplist = ($pschp => $mapp{$pschp});
                   2614:             }
                   2615: 
                   2616: #-------------------------------------------- for each map, gather information
                   2617:             my $mapid;
1.473     amueller 2618:                foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
1.60      albertel 2619:                 my $maptitle = $maplist{$mapid};
1.57      albertel 2620: 
                   2621: #-----------------------  loop through ids and get all parameter types for map
                   2622: #-----------------------------------------          and associated information
                   2623:                 my %name = ();
                   2624:                 my %part = ();
                   2625:                 my %display = ();
                   2626:                 my %type = ();
                   2627:                 my %default = ();
                   2628:                 my $map = 0;
                   2629: 
1.473     amueller 2630: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   2631: 
1.57      albertel 2632:                 foreach (@ids) {
1.473     amueller 2633:                     ($map)=(/([\d]*?)\./);
                   2634:                       my $rid = $_;
1.446     bisitz   2635: 
1.57      albertel 2636: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   2637: 
1.473     amueller 2638:                      if ($map eq $mapid) {
                   2639:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2640: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   2641: 
                   2642: #--------------------------------------------------------------------
                   2643: # @catmarker contains list of all possible parameters including part #s
                   2644: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2645: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2646: # When storing information, store as part 0
                   2647: # When requesting information, request from full part
                   2648: #-------------------------------------------------------------------
1.473     amueller 2649:                         foreach (&keysplit($keyp{$rid})) {
                   2650:                              my $tempkeyp = $_;
                   2651:                               my $fullkeyp = $tempkeyp;
                   2652:                               $tempkeyp =~ s/_\w+_/_0_/;
                   2653: 
                   2654:                               if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2655:                                 $part{$tempkeyp}="0";
                   2656:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2657:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2658:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   2659:                                     my $identifier;
                   2660:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2661:                                         $identifier = $1;
                   2662:                                     }
                   2663:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2664:                                 } else {
                   2665:                                     $display{$tempkeyp} = $parmdis;
                   2666:                                 }
                   2667:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2668:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2669:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2670:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2671:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2672:                               }
                   2673:                         } # end loop through keys
                   2674:                       }
1.57      albertel 2675:                 } # end loop through ids
1.446     bisitz   2676: 
1.57      albertel 2677: #---------------------------------------------------- print header information
1.133     www      2678:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      2679:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   2680:                 my $tmp="";
1.57      albertel 2681:                 if ($uname) {
1.473     amueller 2682:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   2683:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   2684:                         &mt('in')." \n";
1.57      albertel 2685:                 } else {
1.401     bisitz   2686:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 2687:                 }
1.269     raeburn  2688:                 if ($cgroup) {
1.401     bisitz   2689:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   2690:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2691:                     $csec = '';
                   2692:                 } elsif ($csec) {
1.401     bisitz   2693:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   2694:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2695:                 }
1.401     bisitz   2696:                 $r->print('<div align="center"><h4>'
                   2697:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   2698:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   2699:                              ,$tmp
                   2700:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   2701:                              )
                   2702:                          ."<br /></h4>\n"
1.422     bisitz   2703:                 );
1.57      albertel 2704: #---------------------------------------------------------------- print table
1.419     bisitz   2705:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2706:                          .&Apache::loncommon::start_data_table_header_row()
                   2707:                          .'<th>'.&mt('Parameter Name').'</th>'
                   2708:                          .'<th>'.&mt('Default Value').'</th>'
                   2709:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   2710:                          .&Apache::loncommon::end_data_table_header_row()
                   2711:                 );
1.57      albertel 2712: 
1.473     amueller 2713:                 foreach (&keysinorder(\%name,\%keyorder)) {
                   2714:                     $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2715:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2716:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.522.2.19  raeburn  2717:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   2718:                            $readonly);
1.57      albertel 2719:                 }
1.422     bisitz   2720:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   2721:                          .'</div>'
                   2722:                 );
1.57      albertel 2723:             } # end each map
                   2724:         } # end of $parmlev eq map
                   2725: #--------------------------------- Entry for parm level general (Course level)
                   2726:         if ($parmlev eq 'general') {
1.473     amueller 2727:             my $defbgone = '#E0E099';
1.419     bisitz   2728:             my $defbgtwo = '#FFFF99';
                   2729:             my $defbgthree = '#FFBB99';
1.57      albertel 2730: 
                   2731: #-------------------------------------------- for each map, gather information
                   2732:             my $mapid="0.0";
                   2733: #-----------------------  loop through ids and get all parameter types for map
                   2734: #-----------------------------------------          and associated information
                   2735:             my %name = ();
                   2736:             my %part = ();
                   2737:             my %display = ();
                   2738:             my %type = ();
                   2739:             my %default = ();
1.446     bisitz   2740: 
1.57      albertel 2741:             foreach (@ids) {
                   2742:                 my $rid = $_;
1.446     bisitz   2743: 
1.196     www      2744:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2745: 
                   2746: #--------------------------------------------------------------------
                   2747: # @catmarker contains list of all possible parameters including part #s
                   2748: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2749: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2750: # When storing information, store as part 0
                   2751: # When requesting information, request from full part
                   2752: #-------------------------------------------------------------------
1.473     amueller 2753:                 foreach (&keysplit($keyp{$rid})) {
                   2754:                     my $tempkeyp = $_;
                   2755:                       my $fullkeyp = $tempkeyp;
                   2756:                       $tempkeyp =~ s/_\w+_/_0_/;
                   2757:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2758:                         $part{$tempkeyp}="0";
                   2759:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   2760:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2761:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   2762:                             my $identifier;
                   2763:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2764:                                 $identifier = $1;
                   2765:                             }
                   2766:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2767:                         } else {
                   2768:                             $display{$tempkeyp} = $parmdis;
                   2769:                         }
                   2770:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2771:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   2772:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   2773:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2774:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2775:                       }
1.57      albertel 2776:                 } # end loop through keys
                   2777:             } # end loop through ids
1.446     bisitz   2778: 
1.57      albertel 2779: #---------------------------------------------------- print header information
1.473     amueller 2780:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 2781:             $r->print(<<ENDMAPONE);
1.419     bisitz   2782: <center>
                   2783: <h4>$setdef
1.135     albertel 2784: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 2785: ENDMAPONE
                   2786:             if ($uname) {
1.473     amueller 2787:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 2788:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 2789:             } else {
1.135     albertel 2790:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 2791:             }
1.446     bisitz   2792: 
1.135     albertel 2793:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 2794:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 2795:             $r->print("</h4>\n");
1.57      albertel 2796: #---------------------------------------------------------------- print table
1.419     bisitz   2797:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2798:                      .&Apache::loncommon::start_data_table_header_row()
                   2799:                      .'<th>'.&mt('Parameter Name').'</th>'
                   2800:                      .'<th>'.&mt('Default Value').'</th>'
                   2801:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   2802:                      .&Apache::loncommon::end_data_table_header_row()
                   2803:             );
1.57      albertel 2804: 
1.473     amueller 2805:             foreach (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   2806:                 $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2807:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.522.2.19  raeburn  2808:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2809:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   2810:                            $readonly);
1.57      albertel 2811:             }
1.419     bisitz   2812:             $r->print(&Apache::loncommon::end_data_table()
                   2813:                      .'</p>'
                   2814:                      .'</center>'
                   2815:             );
1.57      albertel 2816:         } # end of $parmlev eq general
1.43      albertel 2817:     }
1.507     www      2818:     $r->print('</form>');
                   2819:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 2820: } # end sub assessparms
1.30      www      2821: 
1.120     www      2822: ##################################################
1.207     www      2823: # Overview mode
                   2824: ##################################################
1.124     www      2825: my $tableopen;
                   2826: 
                   2827: sub tablestart {
1.522.2.19  raeburn  2828:     my ($readonly) = @_;
1.124     www      2829:     if ($tableopen) {
1.522.2.19  raeburn  2830:         return '';
1.124     www      2831:     } else {
1.522.2.19  raeburn  2832:         $tableopen=1;
                   2833:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   2834:         if ($readonly) {
                   2835:             $output .= '<th>'.&mt('Current value').'</th>';
                   2836:         } else {
                   2837:             $output .= '<th>'.&mt('Delete').'</th><th>'.&mt('Set to ...').'</th>';
                   2838:         }
                   2839:         $output .= '</tr>';
                   2840:         return $output;
1.124     www      2841:     }
                   2842: }
                   2843: 
                   2844: sub tableend {
                   2845:     if ($tableopen) {
1.473     amueller 2846:     $tableopen=0;
                   2847:     return &Apache::loncommon::end_data_table();
1.124     www      2848:     } else {
1.473     amueller 2849:     return'';
1.124     www      2850:     }
                   2851: }
                   2852: 
1.207     www      2853: sub readdata {
                   2854:     my ($crs,$dom)=@_;
                   2855: # Read coursedata
                   2856:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2857: # Read userdata
                   2858: 
                   2859:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2860:     foreach (keys %$classlist) {
1.350     albertel 2861:         if ($_=~/^($match_username)\:($match_domain)$/) {
1.473     amueller 2862:         my ($tuname,$tudom)=($1,$2);
                   2863:         my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
1.207     www      2864:             foreach my $userkey (keys %{$useropt}) {
1.473     amueller 2865:         if ($userkey=~/^$env{'request.course.id'}/) {
1.207     www      2866:                     my $newkey=$userkey;
1.473     amueller 2867:             $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2868:             $$resourcedata{$newkey}=$$useropt{$userkey};
                   2869:         }
                   2870:         }
                   2871:     }
1.207     www      2872:     }
1.522.2.19  raeburn  2873:     if (wantarray) {
                   2874:         return ($resourcedata,$classlist);
                   2875:     } else {
                   2876:         return $resourcedata;
                   2877:     }
1.207     www      2878: }
                   2879: 
                   2880: 
1.124     www      2881: # Setting
1.208     www      2882: 
                   2883: sub storedata {
                   2884:     my ($r,$crs,$dom)=@_;
1.207     www      2885: # Set userlevel immediately
                   2886: # Do an intermediate store of course level
                   2887:     my $olddata=&readdata($crs,$dom);
1.124     www      2888:     my %newdata=();
                   2889:     undef %newdata;
                   2890:     my @deldata=();
                   2891:     undef @deldata;
1.504     raeburn  2892:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.522.2.16  raeburn  2893:     my $now = time;
1.504     raeburn  2894:     foreach my $key (keys(%env)) { 
                   2895:     if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
1.473     amueller 2896:         my $cmd=$1;
                   2897:         my $thiskey=$2;
                   2898:         my ($tuname,$tudom)=&extractuser($thiskey);
                   2899:         my $tkey=$thiskey;
                   2900:             if ($tuname) {
                   2901:         $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2902:         }
                   2903:         if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.522.2.16  raeburn  2904:         my ($data, $typeof, $text, $name, $valchk);
1.473     amueller 2905:         if ($cmd eq 'set') {
1.504     raeburn  2906:             $data=$env{$key};
1.522.2.16  raeburn  2907:             $valchk = $data;
1.473     amueller 2908:             $typeof=$env{'form.typeof_'.$thiskey};
                   2909:             $text = &mt('Saved modified parameter for');
1.504     raeburn  2910:             if ($typeof eq 'string_questiontype') {
1.514     raeburn  2911:                 $name = 'type';
                   2912:             } elsif ($typeof eq 'string_lenient') {
                   2913:                 $name = 'lenient';
1.521     raeburn  2914:             } elsif ($typeof eq 'string_discussvote') {
                   2915:                 $name = 'discussvote';
1.522.2.7  raeburn  2916:             } elsif ($typeof eq 'string_examcode') {
                   2917:                 $name = 'examcode';
1.522.2.16  raeburn  2918:                 if (&Apache::lonnet::validCODE($data)) {
                   2919:                     $valchk = 'valid';
                   2920:                 }
1.519     raeburn  2921:             } elsif ($typeof eq 'string_yesno') {
                   2922:                 if ($thiskey =~ /\.retrypartial$/) {
                   2923:                     $name = 'retrypartial';
                   2924:                 }
1.514     raeburn  2925:             }
1.522.2.16  raeburn  2926:         } elsif ($cmd eq 'datepointer') {
                   2927:             $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   2928:             $typeof=$env{'form.typeof_'.$thiskey};
                   2929:             $text = &mt('Saved modified date for');
                   2930:             if ($typeof eq 'date_start') {
                   2931:                 if ($thiskey =~ /\.printstartdate$/) {
                   2932:                     $name = 'printstartdate';
                   2933:                     if (($data) && ($data > $now)) {
                   2934:                         $valchk = 'future';
1.504     raeburn  2935:                     }
                   2936:                 }
1.522.2.16  raeburn  2937:             } elsif ($typeof eq 'date_end') {
                   2938:                 if ($thiskey =~ /\.printenddate$/) {
                   2939:                     $name = 'printenddate';
                   2940:                     if (($data) && ($data < $now)) {
                   2941:                         $valchk = 'past';
                   2942:                     }
                   2943:                 }
                   2944:             }
                   2945:         } elsif ($cmd eq 'dateinterval') {
                   2946:             $data=&get_date_interval_from_form($thiskey);
                   2947:             $typeof=$env{'form.typeof_'.$thiskey};
                   2948:             $text = &mt('Saved modified date for');
                   2949:         }
                   2950:         if ($name ne '') {
                   2951:             my ($needsrelease,$needsnewer);
                   2952:             $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk"};
                   2953:             if ($needsrelease) {
                   2954:                 unless ($got_chostname) {
                   2955:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   2956:                     $got_chostname = 1;
                   2957:                 }
                   2958:                 $needsnewer = &parameter_releasecheck($name,$valchk,
                   2959:                                                       $needsrelease,
                   2960:                                                       $cmajor,$cminor);
1.504     raeburn  2961:                 if ($needsnewer) {
1.514     raeburn  2962:                     $r->print('<br />'.&oldversion_warning($name,$data,
                   2963:                                                            $chostname,$cmajor,
1.504     raeburn  2964:                                                            $cminor,$needsrelease));
                   2965:                     next;
                   2966:                 }
                   2967:             }
1.473     amueller 2968:         }
                   2969:         if (defined($data) and $$olddata{$thiskey} ne $data) {
1.207     www      2970:             if ($tuname) {
1.473     amueller 2971:             if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2972:                                  $tkey.'.type' => $typeof},
                   2973:                          $tudom,$tuname) eq 'ok') {
                   2974:                 &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
                   2975:                 $r->print('<br />'.$text.' '.
                   2976:                       &Apache::loncommon::plainname($tuname,$tudom));
                   2977:             } else {
                   2978:                 $r->print('<div class="LC_error">'.
                   2979:                       &mt('Error saving parameters').'</div>');
                   2980:             }
                   2981:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2982:             } else {
                   2983:             $newdata{$thiskey}=$data;
                   2984:              $newdata{$thiskey.'.type'}=$typeof;
1.446     bisitz   2985:                    }
1.473     amueller 2986:         }
                   2987:         } elsif ($cmd eq 'del') {
                   2988:         if ($tuname) {
                   2989:             if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
                   2990:                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   2991:             $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2992:             } else {
                   2993:             $r->print('<div class="LC_error">'.
                   2994:                   &mt('Error deleting parameters').'</div>');
                   2995:             }
                   2996:             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2997:         } else {
                   2998:             push (@deldata,$thiskey,$thiskey.'.type');
                   2999:         }
                   3000:         }
                   3001:     }
1.124     www      3002:     }
1.207     www      3003: # Store all course level
1.144     www      3004:     my $delentries=$#deldata+1;
                   3005:     my @newdatakeys=keys %newdata;
                   3006:     my $putentries=$#newdatakeys+1;
                   3007:     if ($delentries) {
1.473     amueller 3008:     if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   3009:         my %loghash=map { $_ => '' } @deldata;
                   3010:         &log_parmset(\%loghash,1);
1.522.2.18  raeburn  3011:         $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
1.473     amueller 3012:     } else {
                   3013:         $r->print('<div class="LC_error">'.
                   3014:               &mt('Error deleting parameters').'</div>');
                   3015:     }
                   3016:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3017:     }
                   3018:     if ($putentries) {
1.473     amueller 3019:     if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   3020:                 &log_parmset(\%newdata,0);
1.522.2.17  raeburn  3021:         $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
1.473     amueller 3022:     } else {
                   3023:         $r->print('<div class="LC_error">'.
                   3024:               &mt('Error saving parameters').'</div>');
                   3025:     }
                   3026:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      3027:     }
1.208     www      3028: }
1.207     www      3029: 
1.208     www      3030: sub extractuser {
                   3031:     my $key=shift;
1.350     albertel 3032:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      3033: }
1.206     www      3034: 
1.381     albertel 3035: sub parse_listdata_key {
                   3036:     my ($key,$listdata) = @_;
                   3037:     # split into student/section affected, and
                   3038:     # the realm (folder/resource part and parameter
1.446     bisitz   3039:     my ($student,$realm) =
1.473     amueller 3040:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 3041:     # if course wide student would be undefined
                   3042:     if (!defined($student)) {
1.473     amueller 3043:     ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 3044:     }
                   3045:     # strip off the .type if it's not the Question type parameter
                   3046:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.473     amueller 3047:     $realm=~s/\.type//;
1.381     albertel 3048:     }
                   3049:     # split into resource+part and parameter name
1.388     albertel 3050:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   3051:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 3052:     return ($student,$res,$part,$parm);
                   3053: }
                   3054: 
1.208     www      3055: sub listdata {
1.522.2.19  raeburn  3056:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.207     www      3057: # Start list output
1.206     www      3058: 
1.122     www      3059:     my $oldsection='';
                   3060:     my $oldrealm='';
                   3061:     my $oldpart='';
1.123     www      3062:     my $pointer=0;
1.124     www      3063:     $tableopen=0;
1.145     www      3064:     my $foundkeys=0;
1.248     albertel 3065:     my %keyorder=&standardkeyorder();
1.381     albertel 3066: 
1.522.2.24  raeburn  3067:     my ($secidx,%grouphash);
                   3068:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3069:         $secidx = &Apache::loncoursedata::CL_SECTION();
                   3070:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   3071:             %grouphash = &Apache::longroup::coursegroups();
                   3072:         } elsif ($env{'request.course.groups'} ne '') {
                   3073:             map { $grouphash{$_} = 1; } split(/:/,$env{'request.course.groups'});
                   3074:         }
                   3075:     }
                   3076: 
1.214     www      3077:     foreach my $thiskey (sort {
1.473     amueller 3078:     my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   3079:     my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 3080: 
1.473     amueller 3081:     # get the numerical order for the param
                   3082:     $aparm=$keyorder{'parameter_0_'.$aparm};
                   3083:     $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 3084: 
1.473     amueller 3085:     my $result=0;
1.381     albertel 3086: 
1.473     amueller 3087:     if ($sortorder eq 'realmstudent') {
1.381     albertel 3088:             if ($ares     ne $bres    ) {
1.473     amueller 3089:         $result = ($ares     cmp $bres);
1.446     bisitz   3090:             } elsif ($astudent ne $bstudent) {
1.473     amueller 3091:         $result = ($astudent cmp $bstudent);
                   3092:         } elsif ($apart    ne $bpart   ) {
                   3093:         $result = ($apart    cmp $bpart);
                   3094:         }
                   3095:     } else {
                   3096:         if      ($astudent ne $bstudent) {
                   3097:         $result = ($astudent cmp $bstudent);
                   3098:         } elsif ($ares     ne $bres    ) {
                   3099:         $result = ($ares     cmp $bres);
                   3100:         } elsif ($apart    ne $bpart   ) {
                   3101:         $result = ($apart    cmp $bpart);
                   3102:         }
                   3103:     }
1.446     bisitz   3104: 
1.473     amueller 3105:     if (!$result) {
1.381     albertel 3106:             if (defined($aparm) && defined($bparm)) {
1.473     amueller 3107:         $result = ($aparm <=> $bparm);
1.381     albertel 3108:             } elsif (defined($aparm)) {
1.473     amueller 3109:         $result = -1;
1.381     albertel 3110:             } elsif (defined($bparm)) {
1.473     amueller 3111:         $result = 1;
                   3112:         }
                   3113:     }
1.381     albertel 3114: 
1.473     amueller 3115:     $result;
1.214     www      3116:     } keys %{$listdata}) {
1.381     albertel 3117: 
1.473     amueller 3118:     if ($$listdata{$thiskey.'.type'}) {
1.522.2.24  raeburn  3119:         my $thistype=$$listdata{$thiskey.'.type'};
                   3120:         if ($$resourcedata{$thiskey.'.type'}) {
                   3121:             $thistype=$$resourcedata{$thiskey.'.type'};
1.473     amueller 3122:         }
                   3123:         my ($middle,$part,$name)=
                   3124:         ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3125:         my $section=&mt('All Students');
                   3126:         if ($middle=~/^\[(.*)\]/) {
1.522.2.24  raeburn  3127:             my $issection=$1;
                   3128:             if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   3129:                 my ($stuname,$studom) = ($1,$2);
                   3130:                 if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3131:                     if (ref($classlist) eq 'HASH') {
                   3132:                         if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   3133:                             next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'});
                   3134:                         }
                   3135:                     }
                   3136:                 }
                   3137:                 $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   3138:             } else {
                   3139:                 if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3140:                     if (exists($grouphash{$issection})) {
                   3141:                         $section=&mt('Group').': '.$issection;
                   3142:                     } elsif ($issection eq $env{'request.course.sec'}) {
                   3143:                         $section = &mt('Section').': '.$issection;
                   3144:                     } else {
                   3145:                         next;
                   3146:                     }
                   3147:                 } else {
                   3148:                     $section=&mt('Group/Section').': '.$issection;
                   3149:                 }
                   3150:             }
                   3151:             $middle=~s/^\[(.*)\]//;
                   3152:         } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   3153:             $readonly = 1;
1.473     amueller 3154:         }
                   3155:         $middle=~s/\.+$//;
                   3156:         $middle=~s/^\.+//;
                   3157:         my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.522.2.24  raeburn  3158: 
1.473     amueller 3159:         if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   3160:         $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><span class="LC_parm_folder">('.$1.')</span></span>';
                   3161:         } elsif ($middle) {
                   3162:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   3163:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.$id.')</span></span>';
                   3164:         }
                   3165:         if ($sortorder eq 'realmstudent') {
                   3166:         if ($realm ne $oldrealm) {
                   3167:             $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   3168:             $oldrealm=$realm;
                   3169:             $oldsection='';
                   3170:         }
                   3171:         if ($section ne $oldsection) {
                   3172:             $r->print(&tableend()."\n<h2>$section</h2>");
                   3173:             $oldsection=$section;
                   3174:             $oldpart='';
                   3175:         }
                   3176:         } else {
                   3177:         if ($section ne $oldsection) {
                   3178:             $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   3179:             $oldsection=$section;
                   3180:             $oldrealm='';
                   3181:         }
                   3182:         if ($realm ne $oldrealm) {
                   3183:             $r->print(&tableend()."\n<h2>$realm</h2>");
                   3184:             $oldrealm=$realm;
                   3185:             $oldpart='';
                   3186:         }
                   3187:         }
                   3188:         if ($part ne $oldpart) {
                   3189:         $r->print(&tableend().
                   3190:               "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   3191:         $oldpart=$part;
                   3192:         }
1.123     www      3193: #
                   3194: # Ready to print
                   3195: #
1.470     raeburn  3196:             my $parmitem = &standard_parameter_names($name);
1.522.2.19  raeburn  3197:         $r->print(&tablestart($readonly).
1.473     amueller 3198:               &Apache::loncommon::start_data_table_row().
                   3199:               '<td><b>'.&mt($parmitem).
1.522.2.19  raeburn  3200:               '</b></td>');
                   3201:         unless ($readonly) {
                   3202:             $r->print('<td><input type="checkbox" name="del_'.
                   3203:                       $thiskey.'" /></td>');
                   3204:         }
                   3205:         $r->print('<td>');
1.473     amueller 3206:         $foundkeys++;
                   3207:         if (&isdateparm($thistype)) {
1.522.2.19  raeburn  3208:             my $jskey='key_'.$pointer;
                   3209:             my $state;
                   3210:             $pointer++;
                   3211:             if ($readonly) {
                   3212:                 $state = 'disabled';
                   3213:             }
                   3214:             $r->print(
                   3215:                 &Apache::lonhtmlcommon::date_setter('parmform',
                   3216:                                                     $jskey,
                   3217:                                                     $$resourcedata{$thiskey},
                   3218:                                                     '',1,$state));
                   3219:             unless ($readonly) {
                   3220:                 $r->print(
1.277     www      3221: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.413     bisitz   3222: (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.
                   3223: &mt('Shift all dates based on this date').'</a></span>':'').
1.277     www      3224: &date_sanity_info($$resourcedata{$thiskey})
1.473     amueller 3225:               );
1.522.2.19  raeburn  3226:             }
1.473     amueller 3227:         } elsif ($thistype eq 'date_interval') {
1.522.2.19  raeburn  3228:             $r->print(&date_interval_selector($thiskey,
                   3229:                       $$resourcedata{$thiskey},$readonly));
1.473     amueller 3230:         } elsif ($thistype =~ m/^string/) {
1.522.2.19  raeburn  3231:             $r->print(&string_selector($thistype,$thiskey,
                   3232:                       $$resourcedata{$thiskey},$name,$readonly));
1.473     amueller 3233:         } else {
1.522.2.19  raeburn  3234:             $r->print(&default_selector($thiskey,$$resourcedata{$thiskey},$readonly));
1.473     amueller 3235:         }
1.522.2.19  raeburn  3236:         unless ($readonly) {
                   3237:             $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   3238:                       $thistype.'" />');
1.522.2.20  raeburn  3239:         }
1.473     amueller 3240:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
                   3241:     }
1.121     www      3242:     }
1.208     www      3243:     return $foundkeys;
                   3244: }
                   3245: 
1.385     albertel 3246: 
                   3247: sub date_interval_selector {
1.522.2.19  raeburn  3248:     my ($thiskey, $showval, $readonly) = @_;
1.385     albertel 3249:     my $result;
                   3250:     foreach my $which (['days', 86400, 31],
1.473     amueller 3251:                ['hours', 3600, 23],
                   3252:                ['minutes', 60, 59],
                   3253:                ['seconds',  1, 59]) {
                   3254:     my ($name, $factor, $max) = @{ $which };
                   3255:     my $amount = int($showval/$factor);
                   3256:     $showval  %= $factor;
                   3257:     my %select = ((map {$_ => $_} (0..$max)),
                   3258:               'select_form_order' => [0..$max]);
                   3259:     $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
1.522.2.19  raeburn  3260:                            \%select,'',$readonly);
1.473     amueller 3261:     $result .= ' '.&mt($name);
1.385     albertel 3262:     }
1.522.2.19  raeburn  3263:     unless ($readonly) {
                   3264:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   3265:     }
1.385     albertel 3266:     return $result;
                   3267: 
                   3268: }
                   3269: 
                   3270: sub get_date_interval_from_form {
                   3271:     my ($key) = @_;
                   3272:     my $seconds = 0;
                   3273:     foreach my $which (['days', 86400],
1.473     amueller 3274:                ['hours', 3600],
                   3275:                ['minutes', 60],
                   3276:                ['seconds',  1]) {
                   3277:     my ($name, $factor) = @{ $which };
                   3278:     if (defined($env{'form.'.$name.'_'.$key})) {
                   3279:         $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   3280:     }
1.385     albertel 3281:     }
                   3282:     return $seconds;
                   3283: }
                   3284: 
                   3285: 
1.383     albertel 3286: sub default_selector {
1.522.2.19  raeburn  3287:     my ($thiskey, $showval, $readonly) = @_;
                   3288:     my $disabled;
                   3289:     if ($readonly) {
                   3290:         $disabled = ' disabled="disabled"';
                   3291:     }
                   3292:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 3293: }
                   3294: 
1.446     bisitz   3295: my %strings =
1.383     albertel 3296:     (
                   3297:      'string_yesno'
                   3298:              => [[ 'yes', 'Yes' ],
1.473     amueller 3299:          [ 'no', 'No' ]],
1.383     albertel 3300:      'string_problemstatus'
                   3301:              => [[ 'yes', 'Yes' ],
1.473     amueller 3302:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   3303:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   3304:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  3305:      'string_questiontype'
                   3306:              => [[ 'problem', 'Standard Problem'],
                   3307:                  [ 'survey', 'Survey'],
                   3308:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
                   3309:                  [ 'exam', 'Exam'],
                   3310:                  [ 'anonsurvey', 'Anonymous Survey'],
                   3311:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   3312:                  [ 'practice', 'Practice'],
                   3313:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  3314:      'string_lenient'
                   3315:              => [['yes', 'Yes' ],
                   3316:                  [ 'no', 'No' ],
1.521     raeburn  3317:                  [ 'default', 'Default - only bubblesheet grading is lenient' ]],
                   3318:      'string_discussvote'
                   3319:              => [['yes','Yes'],
                   3320:                  ['notended','Yes, unless discussion ended'],
                   3321:                  ['no','No']],
1.383     albertel 3322:      );
                   3323: 
1.505     raeburn  3324: sub standard_string_options {
                   3325:     my ($string_type) = @_;
                   3326:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   3327:         return $strings{$string_type};
                   3328:     }
                   3329:     return;
                   3330: }
1.383     albertel 3331: 
                   3332: sub string_selector {
1.522.2.19  raeburn  3333:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   3334: 
1.383     albertel 3335:     if (!exists($strings{$thistype})) {
1.522.2.19  raeburn  3336:     return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 3337:     }
                   3338: 
1.504     raeburn  3339:     my %skiptype;
1.514     raeburn  3340:     if (($thistype eq 'string_questiontype') || 
1.519     raeburn  3341:         ($thistype eq 'string_lenient') ||
1.521     raeburn  3342:         ($thistype eq 'string_discussvote') ||
1.519     raeburn  3343:         ($name eq 'retrypartial')) {
1.504     raeburn  3344:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   3345:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   3346:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  3347:             my ($parmval, $description) = @{ $possibilities };
                   3348:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval"};
1.504     raeburn  3349:             if ($needsrelease) {
                   3350:                 unless ($got_chostname) {
1.514     raeburn  3351:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  3352:                     $got_chostname = 1;
                   3353:                 }
1.514     raeburn  3354:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$needsrelease,
1.522.2.14  raeburn  3355:                                                        $cmajor,$cminor);
1.504     raeburn  3356:                 if ($needsnewer) {
1.514     raeburn  3357:                     $skiptype{$parmval} = 1;
1.504     raeburn  3358:                 }
                   3359:             }
                   3360:         }
                   3361:     }
1.522.2.19  raeburn  3362:  
                   3363:     my ($result,$disabled);
1.504     raeburn  3364: 
1.522.2.19  raeburn  3365:     if ($readonly) {
                   3366:         $disabled = ' disabled="disabled"';
                   3367:     }
1.504     raeburn  3368:     my $numinrow = 3;
                   3369:     if ($thistype eq 'string_problemstatus') {
                   3370:         $numinrow = 2;
                   3371:     } elsif ($thistype eq 'string_questiontype') {
                   3372:         if (keys(%skiptype) > 0) {
                   3373:              $numinrow = 4;
                   3374:         }
                   3375:     }
                   3376:     my $rem;
                   3377:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   3378:         my $i=0;
                   3379:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   3380:             next unless (ref($possibilities) eq 'ARRAY');
                   3381:             my ($name, $description) = @{ $possibilities };
                   3382:             next if ($skiptype{$name}); 
                   3383:             $rem = $i%($numinrow);
                   3384:             if ($rem == 0) {
                   3385:                 if ($i > 0) {
                   3386:                     $result .= '</tr>';
                   3387:                 }
                   3388:                 $result .= '<tr>';
                   3389:             }
                   3390:             $result .= '<td class="LC_left_item">'.
                   3391:                        '<span class="LC_nobreak"><label>'.
                   3392:                        '<input type="radio" name="set_'.$thiskey.
1.522.2.19  raeburn  3393:                        '" value="'.$name.'"'.$disabled;
1.504     raeburn  3394:             if ($showval eq $name) {
                   3395:                 $result .= ' checked="checked"';
                   3396:             }
                   3397:             $result .= ' />'.&mt($description).'</label></span></td>';
                   3398:             $i++;
                   3399:         }
                   3400:         $rem = @{ $strings{$thistype} }%($numinrow);
                   3401:         my $colsleft = $numinrow - $rem;
                   3402:         if ($colsleft > 1 ) {
                   3403:             $result .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
                   3404:                        '&nbsp;</td>';
                   3405:         } elsif ($colsleft == 1) {
                   3406:             $result .= '<td class="LC_left_item">&nbsp;</td>';
                   3407:         }
                   3408:         $result .= '</tr>';
1.473     amueller 3409:     }
1.504     raeburn  3410:     if ($result) {
                   3411:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 3412:     }
                   3413:     return $result;
                   3414: }
                   3415: 
1.389     www      3416: #
                   3417: # Shift all start and end dates by $shift
                   3418: #
                   3419: 
                   3420: sub dateshift {
                   3421:     my ($shift)=@_;
                   3422:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3423:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3424:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   3425: # ugly retro fix for broken version of types
                   3426:     foreach my $key (keys %data) {
                   3427:         if ($key=~/\wtype$/) {
                   3428:             my $newkey=$key;
                   3429:             $newkey=~s/type$/\.type/;
                   3430:             $data{$newkey}=$data{$key};
                   3431:             delete $data{$key};
                   3432:         }
                   3433:     }
1.391     www      3434:     my %storecontent=();
1.389     www      3435: # go through all parameters and look for dates
                   3436:     foreach my $key (keys %data) {
                   3437:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   3438:           my $newdate=$data{$key}+$shift;
1.391     www      3439:           $storecontent{$key}=$newdate;
1.389     www      3440:        }
                   3441:     }
1.391     www      3442:     my $reply=&Apache::lonnet::cput
                   3443:                 ('resourcedata',\%storecontent,$dom,$crs);
                   3444:     if ($reply eq 'ok') {
                   3445:        &log_parmset(\%storecontent);
                   3446:     }
                   3447:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   3448:     return $reply;
1.389     www      3449: }
                   3450: 
1.208     www      3451: sub newoverview {
1.522.2.19  raeburn  3452:     my ($r,$parm_permission) = @_;
1.280     albertel 3453: 
1.208     www      3454:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3455:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.522.2.19  raeburn  3456:     my $readonly = 1;
                   3457:     if ($parm_permission->{'edit'}) {
                   3458:         undef($readonly);
                   3459:     }
1.414     droeschl 3460:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3461:         text=>"Overview Mode"});
1.522.2.2  raeburn  3462: 
                   3463:     my %loaditems = (
                   3464:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1');",
                   3465:                     );
                   3466:     my $js = '
                   3467: <script type="text/javascript">
                   3468: // <![CDATA[
                   3469: '.
                   3470:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   3471:             &showhide_js()."\n".
                   3472: '// ]]>
                   3473: </script>
                   3474: ';
                   3475:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   3476:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 3477:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      3478:     $r->print($start_page.$breadcrumbs);
1.208     www      3479:     $r->print(<<ENDOVER);
1.232     albertel 3480: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      3481: ENDOVER
1.211     www      3482:     my @ids=();
                   3483:     my %typep=();
                   3484:     my %keyp=();
                   3485:     my %allparms=();
                   3486:     my %allparts=();
                   3487:     my %allmaps=();
                   3488:     my %mapp=();
                   3489:     my %symbp=();
                   3490:     my %maptitles=();
                   3491:     my %uris=();
                   3492:     my %keyorder=&standardkeyorder();
                   3493:     my %defkeytype=();
                   3494: 
                   3495:     my %alllevs=();
                   3496:     $alllevs{'Resource Level'}='full';
1.215     www      3497:     $alllevs{'Map/Folder Level'}='map';
1.211     www      3498:     $alllevs{'Course Level'}='general';
                   3499: 
                   3500:     my $csec=$env{'form.csec'};
1.269     raeburn  3501:     my $cgroup=$env{'form.cgroup'};
1.211     www      3502: 
                   3503:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   3504:     my $pschp=$env{'form.pschp'};
1.506     www      3505: 
1.211     www      3506:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.522.2.1  raeburn  3507:     if (!@psprt) { $psprt[0]='0'; }
1.211     www      3508: 
1.446     bisitz   3509:     my @selected_sections =
1.473     amueller 3510:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      3511:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 3512:     foreach my $sec (@selected_sections) {
                   3513:         if ($sec eq 'all') {
1.211     www      3514:             @selected_sections = ('all');
                   3515:         }
                   3516:     }
1.522.2.24  raeburn  3517:     if ($env{'request.course.sec'} ne '') {
                   3518:         @selected_sections = ($env{'request.course.sec'});
                   3519:     }
1.269     raeburn  3520:     my @selected_groups =
                   3521:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      3522: 
                   3523:     my $pssymb='';
                   3524:     my $parmlev='';
1.446     bisitz   3525: 
1.211     www      3526:     unless ($env{'form.parmlev'}) {
                   3527:         $parmlev = 'map';
                   3528:     } else {
                   3529:         $parmlev = $env{'form.parmlev'};
                   3530:     }
                   3531: 
1.446     bisitz   3532:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 3533:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   3534:                 \%keyorder,\%defkeytype);
1.211     www      3535: 
1.374     albertel 3536:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 3537:         @psprt = keys(%allparts);
1.374     albertel 3538:     }
1.211     www      3539: # Menu to select levels, etc
                   3540: 
1.456     bisitz   3541:     $r->print('<div class="LC_Box">');
1.445     neumanie 3542:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   3543:     $r->print('<div>');
1.522.2.2  raeburn  3544:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      3545:     &levelmenu($r,\%alllevs,$parmlev);
                   3546:     if ($parmlev ne 'general') {
1.447     bisitz   3547:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 3548:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      3549:     }
1.447     bisitz   3550:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3551:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3552:     $r->print('</div></div>');
1.446     bisitz   3553: 
1.456     bisitz   3554:     $r->print('<div class="LC_Box">');
1.452     bisitz   3555:     $r->print('<div>');
1.510     www      3556:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 3557:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   3558:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.522.2.24  raeburn  3559:     my $sectionselector = &sectionmenu(\@selected_sections);
                   3560:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 3561:     $r->print('<table>'.
1.522.2.24  raeburn  3562:               '<tr><th>'.&mt('Parts').'</th>');
                   3563:     if ($sectionselector) {
                   3564:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   3565:     }
                   3566:     if ($groupselector) {
                   3567:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   3568:     }
                   3569:     $r->print('</tr><tr><td>');
1.211     www      3570:     &partmenu($r,\%allparts,\@psprt);
1.522.2.24  raeburn  3571:     $r->print('</td>');
                   3572:     if ($sectionselector) {
                   3573:         $r->print('<td>'.$sectionselector.'</td>');
                   3574:     }
                   3575:     if ($groupselector) {
                   3576:         $r->print('<td>'.$groupselector.'</td>');
                   3577:     }
                   3578:     $r->print('</tr></table>');
1.447     bisitz   3579:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3580:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3581:     $r->print('</div></div>');
                   3582: 
1.456     bisitz   3583:     $r->print('<div class="LC_Box">');
1.452     bisitz   3584:     $r->print('<div>');
1.214     www      3585:     my $sortorder=$env{'form.sortorder'};
                   3586:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3587:     &sortmenu($r,$sortorder);
1.445     neumanie 3588:     $r->print('</div></div>');
1.446     bisitz   3589: 
1.214     www      3590:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   3591: 
1.211     www      3592: # Build the list data hash from the specified parms
                   3593: 
                   3594:     my $listdata;
                   3595:     %{$listdata}=();
                   3596: 
                   3597:     foreach my $cat (@pscat) {
1.269     raeburn  3598:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   3599:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      3600:     }
                   3601: 
1.212     www      3602:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      3603: 
1.481     amueller 3604:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      3605: 
                   3606: # Read modified data
                   3607: 
1.481     amueller 3608:         my $resourcedata=&readdata($crs,$dom);
1.211     www      3609: 
                   3610: # List data
                   3611: 
1.522.2.19  raeburn  3612:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   3613:     }
                   3614:     $r->print(&tableend());
                   3615:     unless ($readonly) {
                   3616:         $r->print(((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':''));
1.211     www      3617:     }
1.522.2.19  raeburn  3618:     $r->print('</form>');
1.507     www      3619:     $r->print(&Apache::loncommon::end_page());
1.208     www      3620: }
                   3621: 
1.269     raeburn  3622: sub secgroup_lister {
                   3623:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   3624:     foreach my $item (@{$selections}) {
                   3625:         foreach my $part (@{$psprt}) {
                   3626:             my $rootparmkey=$env{'request.course.id'};
                   3627:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   3628:                 $rootparmkey.='.['.$item.']';
                   3629:             }
                   3630:             if ($parmlev eq 'general') {
                   3631: # course-level parameter
                   3632:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   3633:                 $$listdata{$newparmkey}=1;
                   3634:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3635:             } elsif ($parmlev eq 'map') {
                   3636: # map-level parameter
                   3637:                 foreach my $mapid (keys %{$allmaps}) {
                   3638:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   3639:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   3640:                     $$listdata{$newparmkey}=1;
                   3641:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3642:                 }
                   3643:             } else {
                   3644: # resource-level parameter
                   3645:                 foreach my $rid (@{$ids}) {
                   3646:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   3647:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   3648:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   3649:                     $$listdata{$newparmkey}=1;
                   3650:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3651:                 }
                   3652:             }
                   3653:         }
                   3654:     }
                   3655: }
                   3656: 
1.208     www      3657: sub overview {
1.522.2.19  raeburn  3658:     my ($r,$parm_permission) = @_;
1.208     www      3659:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3660:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.522.2.19  raeburn  3661:     my $readonly = 1;
                   3662:     if ($parm_permission->{'edit'}) {
                   3663:         undef($readonly);
                   3664:     }
1.414     droeschl 3665:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 3666:     text=>"Overview Mode"});
1.280     albertel 3667:     my $start_page=&Apache::loncommon::start_page('Modify Parameters');
1.298     albertel 3668:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      3669:     $r->print($start_page.$breadcrumbs);
                   3670:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform">');
                   3671: 
1.208     www      3672: # Store modified
1.522.2.19  raeburn  3673:     unless ($readonly) {
                   3674:         &storedata($r,$crs,$dom);
                   3675:     }
1.208     www      3676: 
                   3677: # Read modified data
                   3678: 
1.522.2.19  raeburn  3679:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      3680: 
1.214     www      3681: 
                   3682:     my $sortorder=$env{'form.sortorder'};
                   3683:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3684:     &sortmenu($r,$sortorder);
                   3685: 
1.522.2.19  raeburn  3686:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   3687: 
                   3688:     if ($readonly) {
                   3689:         $r->print('<p>'.$submitbutton.'</p>');
                   3690:     }
                   3691: 
                   3692: 
1.208     www      3693: # List data
                   3694: 
1.522.2.19  raeburn  3695:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
1.208     www      3696: 
1.522.2.19  raeburn  3697:     $r->print(&tableend().'<p>');
                   3698:     if ($foundkeys) {
                   3699:         unless ($readonly) {
                   3700:             $r->print('<p>'.$submitbutton.'</p>');
                   3701:         }
                   3702:     } else {
                   3703:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   3704:     }
                   3705:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      3706: }
1.121     www      3707: 
1.333     albertel 3708: sub clean_parameters {
                   3709:     my ($r) = @_;
                   3710:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3711:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3712: 
1.414     droeschl 3713:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 3714:         text=>"Clean Parameters"});
1.333     albertel 3715:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   3716:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   3717:     $r->print(<<ENDOVER);
                   3718: $start_page
                   3719: $breadcrumbs
                   3720: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   3721: ENDOVER
                   3722: # Store modified
                   3723: 
                   3724:     &storedata($r,$crs,$dom);
                   3725: 
                   3726: # Read modified data
                   3727: 
                   3728:     my $resourcedata=&readdata($crs,$dom);
                   3729: 
                   3730: # List data
                   3731: 
                   3732:     $r->print('<h3>'.
1.473     amueller 3733:           &mt('These parameters refer to resources that do not exist.').
                   3734:           '</h3>'.
                   3735:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   3736:           '<br />');
1.333     albertel 3737:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 3738:           '<tr>'.
                   3739:           '<th>'.&mt('Delete').'</th>'.
                   3740:           '<th>'.&mt('Parameter').'</th>'.
                   3741:           '</tr>');
1.333     albertel 3742:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.473     amueller 3743:     next if (!exists($resourcedata->{$thiskey.'.type'})
                   3744:          && $thiskey=~/\.type$/);
                   3745:     my %data = &parse_key($thiskey);
                   3746:     if (1) { #exists($data{'realm_exists'})
                   3747:         #&& !$data{'realm_exists'}) {
                   3748:         $r->print(&Apache::loncommon::start_data_table_row().
                   3749:               '<tr>'.
                   3750:               '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   3751: 
                   3752:         $r->print('<td>');
                   3753:         my $display_value = $resourcedata->{$thiskey};
                   3754:         if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   3755:         $display_value =
                   3756:             &Apache::lonlocal::locallocaltime($display_value);
                   3757:         }
1.470     raeburn  3758:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   3759:             $parmitem = &mt($parmitem);
1.473     amueller 3760:         $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   3761:               $parmitem,$resourcedata->{$thiskey}));
                   3762:         $r->print('<br />');
                   3763:         if ($data{'scope_type'} eq 'all') {
                   3764:         $r->print(&mt('All users'));
                   3765:         } elsif ($data{'scope_type'} eq 'user') {
                   3766:         $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.522.2.25! raeburn  3767:         } elsif ($data{'scope_type'} eq 'secgroup') {
        !          3768:         $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.473     amueller 3769:         }
                   3770:         $r->print('<br />');
                   3771:         if ($data{'realm_type'} eq 'all') {
                   3772:         $r->print(&mt('All Resources'));
                   3773:         } elsif ($data{'realm_type'} eq 'folder') {
                   3774:         $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   3775:         } elsif ($data{'realm_type'} eq 'symb') {
                   3776:         my ($map,$resid,$url) =
                   3777:             &Apache::lonnet::decode_symb($data{'realm'});
1.522.2.5  raeburn  3778:         $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   3779:                   $url.' <br />&nbsp;&nbsp;&nbsp;',
                   3780:                   $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
1.473     amueller 3781:         }
                   3782:         $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   3783:         $r->print('</td></tr>');
1.446     bisitz   3784: 
1.473     amueller 3785:     }
1.333     albertel 3786:     }
                   3787:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 3788:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      3789:           '</p></form>');
                   3790:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 3791: }
                   3792: 
1.390     www      3793: sub date_shift_one {
                   3794:     my ($r) = @_;
                   3795:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3796:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3797: 
1.414     droeschl 3798:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3799:         text=>"Shifting Dates"});
1.390     www      3800:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3801:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      3802:     $r->print($start_page.$breadcrumbs);
1.522.2.8  raeburn  3803:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      3804:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   3805:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   3806:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.522.2.10  raeburn  3807:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      3808:                                                         'timeshifted',
                   3809:                                                         $env{'form.timebase'},,
                   3810:                                                         '').
                   3811:               '</td></tr></table>'.
                   3812:               '<input type="hidden" name="action" value="dateshift2" />'.
                   3813:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   3814:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
                   3815:     $r->print(&Apache::loncommon::end_page());
                   3816: }
                   3817: 
                   3818: sub date_shift_two {
                   3819:     my ($r) = @_;
                   3820:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3821:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 3822:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 3823:         text=>"Shifting Dates"});
1.390     www      3824:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3825:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      3826:     $r->print($start_page.$breadcrumbs);
1.390     www      3827:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.522.2.13  raeburn  3828:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   3829:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      3830:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.522.2.13  raeburn  3831:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      3832:     my $delta=$timeshifted-$env{'form.timebase'};
                   3833:     &dateshift($delta);
1.522.2.13  raeburn  3834:     $r->print(
                   3835:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   3836:         '<br /><br />'.
                   3837:         &Apache::lonhtmlcommon::actionbox(
                   3838:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.390     www      3839:     $r->print(&Apache::loncommon::end_page());
                   3840: }
                   3841: 
1.333     albertel 3842: sub parse_key {
                   3843:     my ($key) = @_;
                   3844:     my %data;
                   3845:     my ($middle,$part,$name)=
1.473     amueller 3846:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.333     albertel 3847:     $data{'scope_type'} = 'all';
                   3848:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 3849:            $data{'scope'} = $1;
                   3850:     if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   3851:         $data{'scope_type'} = 'user';
                   3852:         $data{'scope'} = [$1,$2];
                   3853:     } else {
1.522.2.25! raeburn  3854:         $data{'scope_type'} = 'secgroup';
1.473     amueller 3855:     }
                   3856:     $middle=~s/^\[(.*)\]//;
1.333     albertel 3857:     }
                   3858:     $middle=~s/\.+$//;
                   3859:     $middle=~s/^\.+//;
                   3860:     $data{'realm_type'}='all';
                   3861:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 3862:     $data{'realm'} = $1;
                   3863:     $data{'realm_type'} = 'folder';
                   3864:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3865:     ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 3866:     } elsif ($middle) {
1.473     amueller 3867:     $data{'realm'} = $middle;
                   3868:     $data{'realm_type'} = 'symb';
                   3869:     $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3870:     my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   3871:     $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 3872:     }
1.446     bisitz   3873: 
1.333     albertel 3874:     $data{'parameter_part'} = $part;
                   3875:     $data{'parameter_name'} = $name;
                   3876: 
                   3877:     return %data;
                   3878: }
                   3879: 
1.239     raeburn  3880: 
1.416     jms      3881: sub header {
1.522.2.3  raeburn  3882:     return &Apache::loncommon::start_page('Content and Problem Settings');
1.416     jms      3883: }
1.193     albertel 3884: 
                   3885: 
                   3886: 
                   3887: sub print_main_menu {
                   3888:     my ($r,$parm_permission)=@_;
                   3889:     #
1.414     droeschl 3890:     $r->print(&header());
1.522.2.3  raeburn  3891:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.522.2.19  raeburn  3892:     my $crstype = &Apache::loncommon::course_type();
                   3893:     my $lc_crstype = lc($crstype);
                   3894: 
1.193     albertel 3895:     $r->print(<<ENDMAINFORMHEAD);
                   3896: <form method="post" enctype="multipart/form-data"
                   3897:       action="/adm/parmset" name="studentform">
                   3898: ENDMAINFORMHEAD
                   3899: #
1.195     albertel 3900:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3901:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 3902:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 3903:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  3904:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.522.2.19  raeburn  3905:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   3906:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  3907:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   3908:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   3909:                                         '/'.$env{'request.course.sec'});
                   3910:     }
1.522.2.19  raeburn  3911:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   3912:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   3913:                                         '/'.$env{'request.course.sec'});
                   3914:     }
                   3915:     my (%linktext,%linktitle,%url);
                   3916:     if ($parm_permission->{'edit'}) {
                   3917:         %linktext = (
                   3918:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   3919:                      settable        => 'Edit Resource Parameters - Table Mode',
                   3920:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   3921:                     );
                   3922:         %linktitle = (
                   3923:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   3924:                      settable        => 'Set/Modify resource parameters in table mode.',
                   3925:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   3926:                      );
                   3927:     } else {
                   3928:         %linktext = (
                   3929:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   3930:                      settable        => 'View Resource Parameters - Table Mode',
                   3931:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   3932:                    );
                   3933:         %linktitle = (
                   3934:                      newoverview     => 'Display resource parameters in overview mode.',
                   3935:                      settable        => 'Display resource parameters in table mode.',
                   3936:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   3937:                      );
                   3938:     }
                   3939:     if ($mgr) {
                   3940:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   3941:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   3942:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   3943:     } elsif ($vgr) {
                   3944:         $linktext{'resettimes'} = 'Display Student Access Times',
                   3945:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   3946:         $url{'resettimes'} = '/adm/accesstimes';
                   3947:     }
1.193     albertel 3948:     my @menu =
1.507     www      3949:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 3950:         items => [
                   3951:           { linktext => 'Portfolio Metadata',
                   3952:             url => '/adm/parmset?action=setrestrictmeta',
1.522.2.19  raeburn  3953:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  3954:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 3955:             icon =>'contact-new.png'   ,
                   3956:             },
1.522.2.19  raeburn  3957:           { linktext => $linktext{'resettimes'},
                   3958:             url => $url{'resettimes'},
1.522.2.20  raeburn  3959:             permission => ($vgr || $mgr),
1.522.2.19  raeburn  3960:             linktitle => $linktitle{'resettimes'},
                   3961:             icon => 'start-here.png',
1.473     amueller 3962:             },
1.520     raeburn  3963:           { linktext => 'Blocking Communication/Resource Access',
                   3964:             url => '/adm/setblock',
1.522.2.19  raeburn  3965:             permission => ($vcb || $dcm),
1.520     raeburn  3966:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   3967:             icon => 'comblock.png',
                   3968:             },
1.473     amueller 3969:           { linktext => 'Set Parameter Setting Default Actions',
                   3970:             url => '/adm/parmset?action=setdefaults',
1.522.2.19  raeburn  3971:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 3972:             linktitle =>'Set default actions for parameters.'  ,
                   3973:             icon => 'folder-new.png'  ,
                   3974:             }]},
                   3975:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   3976:         items => [
                   3977:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   3978:             url => '/adm/helper/parameter.helper',
1.522.2.19  raeburn  3979:             permission => $parm_permission->{'helper'},
1.473     amueller 3980:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   3981:             icon => 'dialog-information.png'  ,
                   3982:             #help => 'Parameter_Helper',
                   3983:             },
1.522.2.19  raeburn  3984:           { linktext => $linktext{'newoverview'},
1.473     amueller 3985:             url => '/adm/parmset?action=newoverview',
1.522.2.19  raeburn  3986:             permission => $parm_permission->{'newoverview'},
                   3987:             linktitle => $linktitle{'newoverview'},
                   3988:             icon => 'edit-find.png',
1.473     amueller 3989:             #help => 'Parameter_Overview',
                   3990:             },
1.522.2.19  raeburn  3991:           { linktext => $linktext{'settable'},
1.473     amueller 3992:             url => '/adm/parmset?action=settable',
1.522.2.19  raeburn  3993:             permission => $parm_permission->{'settable'},
                   3994:             linktitle => $linktitle{'settable'},
                   3995:             icon => 'edit-copy.png',
1.473     amueller 3996:             #help => 'Table_Mode',
                   3997:             }]},
1.417     droeschl 3998:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 3999:          items => [
1.522.2.19  raeburn  4000:           { linktext => $linktext{'setoverview'},
1.473     amueller 4001:             url => '/adm/parmset?action=setoverview',
1.522.2.19  raeburn  4002:             permission => $parm_permission->{'setoverview'},
                   4003:             linktitle => $linktitle{'setoverview'},
                   4004:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 4005:             #help => 'Parameter_Overview',
                   4006:             },
                   4007:           { linktext => 'Change Log',
                   4008:             url => '/adm/parmset?action=parameterchangelog',
1.522.2.19  raeburn  4009:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  4010:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 4011:             icon => 'document-properties.png',
1.473     amueller 4012:             }]}
1.193     albertel 4013:           );
1.414     droeschl 4014:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.522.2.8  raeburn  4015:     $r->print('</form>'.&Apache::loncommon::end_page());
1.193     albertel 4016:     return;
                   4017: }
1.414     droeschl 4018: 
1.416     jms      4019: 
                   4020: 
1.252     banghart 4021: sub output_row {
1.347     banghart 4022:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 4023:     my $output;
1.263     banghart 4024:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   4025:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 4026:     if (!defined($options)) {
1.254     banghart 4027:         $options = 'active,stuadd';
1.261     banghart 4028:         $values = '';
1.252     banghart 4029:     }
1.337     banghart 4030:     if (!($options =~ /deleted/)) {
                   4031:         my @options= ( ['active', 'Show to student'],
1.418     schafran 4032:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 4033:                     ['choices','Provide choices for students to select from']);
1.473     amueller 4034: #           ['onlyone','Student may select only one choice']);
1.337     banghart 4035:         if ($added_flag) {
                   4036:             push @options,['deleted', 'Delete Metadata Field'];
                   4037:         }
1.351     banghart 4038:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   4039:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 4040:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 4041:         foreach my $opt (@options) {
1.473     amueller 4042:         my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   4043:         $output .= &Apache::loncommon::continue_data_table_row();
                   4044:         $output .= '<td>'.('&nbsp;' x 5).'<label>
                   4045:                    <input type="checkbox" name="'.
                   4046:                    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   4047:                    &mt($opt->[1]).'</label></td>';
                   4048:         $output .= &Apache::loncommon::end_data_table_row();
                   4049:     }
1.351     banghart 4050:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   4051:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 4052:         $output .= &Apache::loncommon::end_data_table_row();
                   4053:         my $multiple_checked;
                   4054:         my $single_checked;
                   4055:         if ($options =~ m/onlyone/) {
1.422     bisitz   4056:             $multiple_checked = '';
1.423     bisitz   4057:             $single_checked = ' checked="checked"';
1.351     banghart 4058:         } else {
1.423     bisitz   4059:             $multiple_checked = ' checked="checked"';
1.422     bisitz   4060:             $single_checked = '';
1.351     banghart 4061:         }
1.473     amueller 4062:     $output .= &Apache::loncommon::continue_data_table_row();
                   4063:     $output .= '<td>'.('&nbsp;' x 10).'
                   4064:                 <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   4065:                 '.&mt('Student may select multiple choices from list').'</td>';
                   4066:     $output .= &Apache::loncommon::end_data_table_row();
                   4067:     $output .= &Apache::loncommon::continue_data_table_row();
                   4068:     $output .= '<td>'.('&nbsp;' x 10).'
                   4069:                 <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   4070:                 '.&mt('Student may select only one choice from list').'</td>';
                   4071:     $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 4072:     }
                   4073:     return ($output);
                   4074: }
1.416     jms      4075: 
                   4076: 
                   4077: 
1.340     banghart 4078: sub order_meta_fields {
                   4079:     my ($r)=@_;
                   4080:     my $idx = 1;
                   4081:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4082:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.341     banghart 4083:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.414     droeschl 4084:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 4085:         text=>"Add Metadata Field"});
1.345     banghart 4086:     &Apache::lonhtmlcommon::add_breadcrumb
                   4087:             ({href=>"/adm/parmset?action=setrestrictmeta",
                   4088:               text=>"Restrict Metadata"},
                   4089:              {text=>"Order Metadata"});
                   4090:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.340     banghart 4091:     if ($env{'form.storeorder'}) {
                   4092:         my $newpos = $env{'form.newpos'} - 1;
                   4093:         my $currentpos = $env{'form.currentpos'} - 1;
                   4094:         my @neworder = ();
                   4095:         my @oldorder = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   4096:         my $i;
1.341     banghart 4097:         if ($newpos > $currentpos) {
1.340     banghart 4098:         # moving stuff up
                   4099:             for ($i=0;$i<$currentpos;$i++) {
1.473     amueller 4100:             $neworder[$i]=$oldorder[$i];
1.340     banghart 4101:             }
                   4102:             for ($i=$currentpos;$i<$newpos;$i++) {
1.473     amueller 4103:             $neworder[$i]=$oldorder[$i+1];
1.340     banghart 4104:             }
                   4105:             $neworder[$newpos]=$oldorder[$currentpos];
                   4106:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.473     amueller 4107:             $neworder[$i]=$oldorder[$i];
1.340     banghart 4108:             }
                   4109:         } else {
                   4110:         # moving stuff down
1.473     amueller 4111:             for ($i=0;$i<$newpos;$i++) {
                   4112:                 $neworder[$i]=$oldorder[$i];
                   4113:             }
                   4114:             $neworder[$newpos]=$oldorder[$currentpos];
                   4115:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   4116:                 $neworder[$i]=$oldorder[$i-1];
                   4117:             }
                   4118:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   4119:                 $neworder[$i]=$oldorder[$i];
                   4120:             }
1.340     banghart 4121:         }
1.473     amueller 4122:     my $ordered_fields = join ",", @neworder;
1.343     banghart 4123:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   4124:                            {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
1.473     amueller 4125:     &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 4126:     }
1.357     raeburn  4127:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 4128:     my $ordered_fields;
1.340     banghart 4129:     my @fields_in_order = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   4130:     if (!@fields_in_order) {
                   4131:         # no order found, pick sorted order then create metadata.addedorder key.
                   4132:         foreach my $key (sort keys %$fields) {
                   4133:             push @fields_in_order, $key;
1.341     banghart 4134:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 4135:         }
1.341     banghart 4136:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   4137:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   4138:     }
1.340     banghart 4139:     $r->print('<table>');
                   4140:     my $num_fields = scalar(@fields_in_order);
                   4141:     foreach my $key (@fields_in_order) {
                   4142:         $r->print('<tr><td>');
                   4143:         $r->print('<form method="post" action="">');
1.522.2.8  raeburn  4144:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 4145:         for (my $i = 1;$i le $num_fields;$i ++) {
                   4146:             if ($i eq $idx) {
                   4147:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   4148:             } else {
                   4149:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   4150:             }
                   4151:         }
                   4152:         $r->print('</select></td><td>');
                   4153:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   4154:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   4155:         $r->print('</form>');
                   4156:         $r->print($$fields{$key}.'</td></tr>');
                   4157:         $idx ++;
                   4158:     }
                   4159:     $r->print('</table>');
                   4160:     return 'ok';
                   4161: }
1.416     jms      4162: 
                   4163: 
1.359     banghart 4164: sub continue {
                   4165:     my $output;
                   4166:     $output .= '<form action="" method="post">';
                   4167:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
1.522.2.25! raeburn  4168:     $output .= '<input type="submit" value="'.&mt('Continue').'" />';
1.359     banghart 4169:     return ($output);
                   4170: }
1.416     jms      4171: 
                   4172: 
1.334     banghart 4173: sub addmetafield {
                   4174:     my ($r)=@_;
1.414     droeschl 4175:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 4176:         text=>"Add Metadata Field"});
1.334     banghart 4177:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   4178:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 4179:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4180:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.339     banghart 4181:     if (exists($env{'form.undelete'})) {
1.358     banghart 4182:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 4183:         foreach my $meta_field(@meta_fields) {
                   4184:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   4185:             $options =~ s/deleted//;
                   4186:             $options =~ s/,,/,/;
                   4187:             my $put_result = &Apache::lonnet::put('environment',
                   4188:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   4189: 
1.522.2.25! raeburn  4190:             $r->print(&mt('Undeleted Metadata Field [_1] with result [_2]',
        !          4191:                           '<strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}.
        !          4192:                           '</strong>',$put_result).
        !          4193:                       '<br />');
1.339     banghart 4194:         }
1.359     banghart 4195:         $r->print(&continue());
1.339     banghart 4196:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 4197:         my $meta_field = $env{'form.fieldname'};
                   4198:         my $display_field = $env{'form.fieldname'};
                   4199:         $meta_field =~ s/\W/_/g;
1.338     banghart 4200:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 4201:         my $put_result = &Apache::lonnet::put('environment',
                   4202:                             {'metadata.'.$meta_field.'.values'=>"",
                   4203:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   4204:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.522.2.25! raeburn  4205:         $r->print(&mt('Added new Metadata Field [_1] with result [_2]',
        !          4206:                       '<strong>'.$env{'form.fieldname'}.'</strong>',$put_result).
        !          4207:                   '<br />');
1.359     banghart 4208:         $r->print(&continue());
1.335     banghart 4209:     } else {
1.357     raeburn  4210:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 4211:         if ($fields) {
1.522.2.25! raeburn  4212:             $r->print(&mt('You may undelete previously deleted fields.').
        !          4213:                       '<br />'.
        !          4214:                       &mt('Check those you wish to undelete and click Undelete.').
        !          4215:                       '<br />');
1.339     banghart 4216:             $r->print('<form method="post" action="">');
                   4217:             foreach my $key(keys(%$fields)) {
1.358     banghart 4218:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 4219:             }
                   4220:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   4221:             $r->print('</form>');
                   4222:         }
1.522.2.25! raeburn  4223:         $r->print('<hr />'.
        !          4224:                   &mt('[_1]Or[_2] you may enter a new metadata field name.',
        !          4225:                       '<strong>','</strong>').
        !          4226:                  '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 4227:         $r->print('<input type="text" name="fieldname" /><br />');
1.522.2.25! raeburn  4228:         $r->print('<input type="submit" value="'.&mt('Add Metadata Field').'" />');
1.334     banghart 4229:     }
1.361     albertel 4230:     $r->print('</form>');
1.334     banghart 4231: }
1.416     jms      4232: 
                   4233: 
                   4234: 
1.259     banghart 4235: sub setrestrictmeta {
1.240     banghart 4236:     my ($r)=@_;
1.242     banghart 4237:     my $next_meta;
1.244     banghart 4238:     my $output;
1.245     banghart 4239:     my $item_num;
1.246     banghart 4240:     my $put_result;
1.414     droeschl 4241:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 4242:         text=>"Restrict Metadata"});
1.280     albertel 4243:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 4244:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 4245:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4246:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 4247:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 4248:     my $save_field = '';
1.522.2.25! raeburn  4249:     my %lt = &Apache::lonlocal::texthash(
        !          4250:                                            addm => 'Add Metadata Field',
        !          4251:                                            ordm => 'Order Metadata Fields',
        !          4252:                                            save => 'Save',
        !          4253:                                         );
1.259     banghart 4254:     if ($env{'form.restrictmeta'}) {
1.254     banghart 4255:         foreach my $field (sort(keys(%env))) {
1.252     banghart 4256:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 4257:                 my $options;
1.252     banghart 4258:                 my $meta_field = $1;
                   4259:                 my $meta_key = $2;
1.253     banghart 4260:                 if ($save_field ne $meta_field) {
1.252     banghart 4261:                     $save_field = $meta_field;
1.473     amueller 4262:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   4263:                         $options.='stuadd,';
                   4264:                     }
                   4265:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   4266:                         $options.='choices,';
                   4267:                     }
                   4268:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   4269:                         $options.='onlyone,';
                   4270:                     }
                   4271:                     if ($env{'form.'.$meta_field.'_active'}) {
                   4272:                         $options.='active,';
                   4273:                     }
                   4274:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   4275:                         $options.='deleted,';
                   4276:                     }
1.259     banghart 4277:                     my $name = $save_field;
1.253     banghart 4278:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 4279:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   4280:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 4281:                                                    },$dom,$crs);
1.252     banghart 4282:                 }
                   4283:             }
                   4284:         }
                   4285:     }
1.296     albertel 4286:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 4287:                        {'freshen_cache' => 1});
1.335     banghart 4288:     # Get the default metadata fields
1.258     albertel 4289:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 4290:     # Now get possible added metadata fields
1.357     raeburn  4291:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.347     banghart 4292:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 4293:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 4294:         if ($field ne 'courserestricted') {
1.473     amueller 4295:         $output.= &output_row($r, $field, $metadata_fields{$field});
                   4296:     }
1.255     banghart 4297:     }
1.351     banghart 4298:     my $buttons = (<<ENDButtons);
1.522.2.25! raeburn  4299:         <input type="submit" name="restrictmeta" value="$lt{'save'}" />
1.351     banghart 4300:         </form><br />
                   4301:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
1.522.2.25! raeburn  4302:         <input type="submit" name="restrictmeta" value="$lt{'addm'}" />
1.351     banghart 4303:         </form>
                   4304:         <br />
                   4305:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
1.522.2.25! raeburn  4306:         <input type="submit" name="restrictmeta" value="$lt{'ordm'}" />
1.351     banghart 4307: ENDButtons
1.337     banghart 4308:     my $added_flag = 1;
1.335     banghart 4309:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.522.2.25! raeburn  4310:         $output.= &output_row($r,$field,$$added_metadata_fields{$field},$added_flag);
1.335     banghart 4311:     }
1.347     banghart 4312:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   4313:     $r->print(<<ENDenv);
1.259     banghart 4314:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 4315:         $output
1.351     banghart 4316:         $buttons
1.340     banghart 4317:         </form>
1.244     banghart 4318: ENDenv
1.280     albertel 4319:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 4320:     return 'ok';
                   4321: }
1.416     jms      4322: 
                   4323: 
                   4324: 
1.335     banghart 4325: sub get_added_meta_fieldnames {
1.357     raeburn  4326:     my ($cid) = @_;
1.335     banghart 4327:     my %fields;
                   4328:     foreach my $key(%env) {
1.357     raeburn  4329:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 4330:             my $field_name = $1;
                   4331:             my ($display_field_name) = $env{$key};
                   4332:             $fields{$field_name} = $display_field_name;
                   4333:         }
                   4334:     }
                   4335:     return \%fields;
                   4336: }
1.416     jms      4337: 
                   4338: 
                   4339: 
1.339     banghart 4340: sub get_deleted_meta_fieldnames {
1.357     raeburn  4341:     my ($cid) = @_;
1.339     banghart 4342:     my %fields;
                   4343:     foreach my $key(%env) {
1.357     raeburn  4344:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 4345:             my $field_name = $1;
                   4346:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   4347:                 my ($display_field_name) = $env{$key};
                   4348:                 $fields{$field_name} = $display_field_name;
                   4349:             }
                   4350:         }
                   4351:     }
                   4352:     return \%fields;
                   4353: }
1.220     www      4354: sub defaultsetter {
1.280     albertel 4355:     my ($r) = @_;
                   4356: 
1.414     droeschl 4357:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 4358:         text=>"Set Defaults"});
1.446     bisitz   4359:     my $start_page =
1.473     amueller 4360:     &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 4361:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      4362:     $r->print($start_page.$breadcrumbs);
                   4363:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 4364: 
                   4365:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4366:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      4367:     my @ids=();
                   4368:     my %typep=();
                   4369:     my %keyp=();
                   4370:     my %allparms=();
                   4371:     my %allparts=();
                   4372:     my %allmaps=();
                   4373:     my %mapp=();
                   4374:     my %symbp=();
                   4375:     my %maptitles=();
                   4376:     my %uris=();
                   4377:     my %keyorder=&standardkeyorder();
                   4378:     my %defkeytype=();
                   4379: 
1.446     bisitz   4380:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 4381:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   4382:                 \%keyorder,\%defkeytype);
1.224     www      4383:     if ($env{'form.storerules'}) {
1.473     amueller 4384:     my %newrules=();
                   4385:     my @delrules=();
                   4386:     my %triggers=();
                   4387:     foreach my $key (keys(%env)) {
1.225     albertel 4388:             if ($key=~/^form\.(\w+)\_action$/) {
1.473     amueller 4389:         my $tempkey=$1;
                   4390:         my $action=$env{$key};
1.226     www      4391:                 if ($action) {
1.473     amueller 4392:             $newrules{$tempkey.'_action'}=$action;
                   4393:             if ($action ne 'default') {
                   4394:             my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   4395:             $triggers{$whichparm}.=$tempkey.':';
                   4396:             }
                   4397:             $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   4398:             if (&isdateparm($defkeytype{$tempkey})) {
                   4399:             $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   4400:             $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   4401:             $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   4402:             $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   4403:             } else {
                   4404:             $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   4405:             $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   4406:             }
                   4407:         } else {
                   4408:             push(@delrules,$tempkey.'_action');
                   4409:             push(@delrules,$tempkey.'_type');
                   4410:             push(@delrules,$tempkey.'_hours');
                   4411:             push(@delrules,$tempkey.'_min');
                   4412:             push(@delrules,$tempkey.'_sec');
                   4413:             push(@delrules,$tempkey.'_value');
                   4414:         }
                   4415:         }
                   4416:     }
                   4417:     foreach my $key (keys %allparms) {
                   4418:         $newrules{$key.'_triggers'}=$triggers{$key};
                   4419:     }
                   4420:     &Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   4421:     &Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   4422:     &resetrulescache();
1.224     www      4423:     }
1.227     www      4424:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 4425:                        'hours' => 'Hours',
                   4426:                        'min' => 'Minutes',
                   4427:                        'sec' => 'Seconds',
                   4428:                        'yes' => 'Yes',
                   4429:                        'no' => 'No');
1.222     www      4430:     my @standardoptions=('','default');
                   4431:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   4432:     my @dateoptions=('','default');
                   4433:     my @datedisplay=('',&mt('Default value when manually setting'));
                   4434:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4435:     unless ($tempkey) { next; }
                   4436:     push @standardoptions,'when_setting_'.$tempkey;
                   4437:     push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   4438:     if (&isdateparm($defkeytype{$tempkey})) {
                   4439:         push @dateoptions,'later_than_'.$tempkey;
                   4440:         push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   4441:         push @dateoptions,'earlier_than_'.$tempkey;
                   4442:         push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   4443:     }
1.222     www      4444:     }
1.231     www      4445: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
1.473     amueller 4446:       &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 4447:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 4448:           &Apache::loncommon::start_data_table_header_row().
                   4449:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   4450:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   4451:           &Apache::loncommon::end_data_table_header_row());
1.221     www      4452:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.473     amueller 4453:     unless ($tempkey) { next; }
                   4454:     $r->print("\n".&Apache::loncommon::start_data_table_row().
                   4455:           "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   4456:     my $action=&rulescache($tempkey.'_action');
                   4457:     $r->print('<select name="'.$tempkey.'_action">');
                   4458:     if (&isdateparm($defkeytype{$tempkey})) {
                   4459:         for (my $i=0;$i<=$#dateoptions;$i++) {
                   4460:         if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   4461:         $r->print("\n<option value='$dateoptions[$i]'".
                   4462:               ($dateoptions[$i] eq $action?' selected="selected"':'').
                   4463:               ">$datedisplay[$i]</option>");
                   4464:         }
                   4465:     } else {
                   4466:         for (my $i=0;$i<=$#standardoptions;$i++) {
                   4467:         if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   4468:         $r->print("\n<option value='$standardoptions[$i]'".
                   4469:               ($standardoptions[$i] eq $action?' selected="selected"':'').
                   4470:               ">$standarddisplay[$i]</option>");
                   4471:         }
                   4472:     }
                   4473:     $r->print('</select>');
                   4474:     unless (&isdateparm($defkeytype{$tempkey})) {
                   4475:         $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   4476:               '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   4477:     }
                   4478:     $r->print("\n</td><td>\n");
1.222     www      4479: 
1.221     www      4480:         if (&isdateparm($defkeytype{$tempkey})) {
1.473     amueller 4481:         my $days=&rulescache($tempkey.'_days');
                   4482:         my $hours=&rulescache($tempkey.'_hours');
                   4483:         my $min=&rulescache($tempkey.'_min');
                   4484:         my $sec=&rulescache($tempkey.'_sec');
                   4485:         $r->print(<<ENDINPUTDATE);
1.227     www      4486: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      4487: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   4488: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   4489: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      4490: ENDINPUTDATE
1.473     amueller 4491:     } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      4492:             my $yeschecked='';
                   4493:             my $nochecked='';
1.444     bisitz   4494:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   4495:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
1.222     www      4496: 
1.473     amueller 4497:         $r->print(<<ENDYESNO);
1.444     bisitz   4498: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   4499: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.221     www      4500: ENDYESNO
                   4501:         } else {
1.473     amueller 4502:         $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   4503:     }
1.318     albertel 4504:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      4505:     }
1.318     albertel 4506:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 4507:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      4508:           &mt('Save').'" /></form>'."\n");
                   4509:     $r->print(&Apache::loncommon::end_page());
1.220     www      4510:     return;
                   4511: }
1.193     albertel 4512: 
1.290     www      4513: sub components {
1.330     albertel 4514:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   4515: 
                   4516:     if ($typeflag) {
1.473     amueller 4517:     $key=~s/\.type$//;
1.290     www      4518:     }
1.330     albertel 4519: 
                   4520:     my ($middle,$part,$name)=
1.473     amueller 4521:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      4522:     my $issection;
1.330     albertel 4523: 
1.290     www      4524:     my $section=&mt('All Students');
                   4525:     if ($middle=~/^\[(.*)\]/) {
1.473     amueller 4526:     $issection=$1;
                   4527:     $section=&mt('Group/Section').': '.$issection;
                   4528:     $middle=~s/^\[(.*)\]//;
1.290     www      4529:     }
                   4530:     $middle=~s/\.+$//;
                   4531:     $middle=~s/^\.+//;
1.291     www      4532:     if ($uname) {
1.473     amueller 4533:     $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   4534:     $issection='';
1.291     www      4535:     }
1.316     albertel 4536:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   4537:     my $realmdescription=&mt('all resources');
1.290     www      4538:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.473     amueller 4539:     $realm='<span class="LC_parm_scope_folder">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <span class="LC_parm_folder"><br />('.$1.')</span></span>';
                   4540:      $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($1);
1.304     www      4541:    } elsif ($middle) {
1.473     amueller 4542:     my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4543:     $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.$id.')</span></span>';
                   4544:     $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      4545:     }
1.291     www      4546:     my $what=$part.'.'.$name;
1.330     albertel 4547:     return ($realm,$section,$name,$part,
1.473     amueller 4548:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      4549: }
1.293     www      4550: 
1.328     albertel 4551: my %standard_parms;
1.469     raeburn  4552: my %standard_parms_types;
1.416     jms      4553: 
1.328     albertel 4554: sub load_parameter_names {
1.522.2.25! raeburn  4555:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 4556:     while (my $configline=<$config>) {
1.473     amueller 4557:     if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   4558:     chomp($configline);
                   4559:     my ($short,$plain)=split(/:/,$configline);
                   4560:     my (undef,$name,$type)=split(/\&/,$short,3);
                   4561:     if ($type eq 'display') {
                   4562:         $standard_parms{$name} = $plain;
1.469     raeburn  4563:         } elsif ($type eq 'type') {
                   4564:             $standard_parms_types{$name} = $plain;
                   4565:         }
1.328     albertel 4566:     }
                   4567:     close($config);
                   4568:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   4569:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.522.2.25! raeburn  4570:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 4571: }
                   4572: 
1.292     www      4573: sub standard_parameter_names {
                   4574:     my ($name)=@_;
1.328     albertel 4575:     if (!%standard_parms) {
1.473     amueller 4576:     &load_parameter_names();
1.328     albertel 4577:     }
1.292     www      4578:     if ($standard_parms{$name}) {
1.473     amueller 4579:     return $standard_parms{$name};
1.446     bisitz   4580:     } else {
1.473     amueller 4581:     return $name;
1.292     www      4582:     }
                   4583: }
1.290     www      4584: 
1.469     raeburn  4585: sub standard_parameter_types {
                   4586:     my ($name)=@_;
                   4587:     if (!%standard_parms_types) {
                   4588:         &load_parameter_names();
                   4589:     }
                   4590:     if ($standard_parms_types{$name}) {
                   4591:         return $standard_parms_types{$name};
                   4592:     }
                   4593:     return;
                   4594: }
1.309     www      4595: 
1.285     albertel 4596: sub parm_change_log {
1.522.2.19  raeburn  4597:     my ($r,$parm_permission)=@_;
1.414     droeschl 4598:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 4599:     text=>"Parameter Change Log"});
1.522     raeburn  4600:     my $js = '<script type="text/javascript">'."\n".
                   4601:              '// <![CDATA['."\n".
                   4602:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   4603:              '// ]]>'."\n".
                   4604:              '</script>'."\n";
                   4605:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 4606:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.286     www      4607:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
1.473     amueller 4608:                       $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4609:                       $env{'course.'.$env{'request.course.id'}.'.num'});
1.311     albertel 4610: 
1.301     www      4611:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 4612: 
1.522     raeburn  4613:     $r->print('<div class="LC_left_float">'.
                   4614:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   4615:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 4616:                      method="post" name="parameterlog">');
1.446     bisitz   4617: 
1.311     albertel 4618:     my %saveable_parameters = ('show' => 'scalar',);
                   4619:     &Apache::loncommon::store_course_settings('parameter_log',
                   4620:                                               \%saveable_parameters);
                   4621:     &Apache::loncommon::restore_course_settings('parameter_log',
                   4622:                                                 \%saveable_parameters);
1.522     raeburn  4623:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   4624:               '<input type="submit" value="'.&mt('Display').'" />'.
                   4625:               '</form></fieldset></div><br clear="all" />');
1.522.2.19  raeburn  4626:     my $readonly = 1;
                   4627:     if ($parm_permission->{'edit'}) {
                   4628:         undef($readonly);
                   4629:     }
1.291     www      4630:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
1.473     amueller 4631:                              $env{'course.'.$env{'request.course.id'}.'.domain'});
1.301     www      4632:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 4633:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.522.2.19  raeburn  4634:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   4635:     unless ($readonly) {
                   4636:         $r->print('<th>'.&mt('Announce').'</th>');
                   4637:     }
                   4638:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      4639:     my $shown=0;
1.349     www      4640:     my $folder='';
                   4641:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.473     amueller 4642:     my $last='';
                   4643:     if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   4644:         &GDBM_READER(),0640)) {
                   4645:         $last=$hash{'last_known'};
                   4646:         untie(%hash);
                   4647:     }
                   4648:     if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
1.349     www      4649:     }
1.446     bisitz   4650:     foreach my $id (sort
1.473     amueller 4651:             {
                   4652:             if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   4653:                 return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   4654:             }
                   4655:             my $aid = (split('00000',$a))[-1];
                   4656:             my $bid = (split('00000',$b))[-1];
                   4657:             return $bid<=>$aid;
                   4658:             } (keys(%parmlog))) {
1.294     www      4659:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.473     amueller 4660:     my $count = 0;
                   4661:     my $time =
                   4662:         &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   4663:     my $plainname =
                   4664:         &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   4665:                       $parmlog{$id}{'exe_udom'});
                   4666:     my $about_me_link =
                   4667:         &Apache::loncommon::aboutmewrapper($plainname,
                   4668:                            $parmlog{$id}{'exe_uname'},
                   4669:                            $parmlog{$id}{'exe_udom'});
                   4670:     my $send_msg_link='';
1.522.2.19  raeburn  4671:     if ((!$readonly) && 
                   4672:         (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.473     amueller 4673:          || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   4674:         $send_msg_link ='<br />'.
                   4675:         &Apache::loncommon::messagewrapper(&mt('Send message'),
                   4676:                            $parmlog{$id}{'exe_uname'},
                   4677:                            $parmlog{$id}{'exe_udom'});
                   4678:     }
                   4679:     my $row_start=&Apache::loncommon::start_data_table_row();
                   4680:     my $makenewrow=0;
                   4681:     my %istype=();
                   4682:     my $output;
                   4683:     foreach my $changed (reverse(sort(@changes))) {
1.330     albertel 4684:             my $value=$parmlog{$id}{'logentry'}{$changed};
1.473     amueller 4685:         my $typeflag = ($changed =~/\.type$/ &&
                   4686:                 !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 4687:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.473     amueller 4688:         &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
1.522.2.24  raeburn  4689:         if ($env{'request.course.sec'} ne '') {
                   4690:             next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   4691:             if ($uname ne '') {
                   4692:                 my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   4693:                 next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'}));
                   4694:             }
                   4695:         }
1.473     amueller 4696:         if ($env{'form.displayfilter'} eq 'currentfolder') {
                   4697:         if ($folder) {
                   4698:             if ($middle!~/^\Q$folder\E/) { next; }
                   4699:         }
                   4700:         }
                   4701:         if ($typeflag) {
                   4702:         $istype{$parmname}=$value;
                   4703:         if (!$env{'form.includetypes'}) { next; }
                   4704:         }
                   4705:         $count++;
                   4706:         if ($makenewrow) {
                   4707:         $output .= $row_start;
                   4708:         } else {
                   4709:         $makenewrow=1;
                   4710:         }
1.470     raeburn  4711:             my $parmitem = &standard_parameter_names($parmname);
1.473     amueller 4712:         $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   4713:               &mt($parmitem).'</td><td>'.
                   4714:               ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   4715:         my $stillactive=0;
                   4716:         if ($parmlog{$id}{'delflag'}) {
                   4717:         $output .= &mt('Deleted');
                   4718:         } else {
                   4719:         if ($typeflag) {
1.470     raeburn  4720:                     my $parmitem = &standard_parameter_names($value); 
                   4721:                     $parmitem = &mt($parmitem);
1.473     amueller 4722:             $output .= &mt('Type: [_1]',$parmitem);
                   4723:         } else {
                   4724:             my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   4725:                               $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  4726:                     my $showvalue = $value;
                   4727:                     if ($istype{$parmname} eq '') {
                   4728:                         my $type = &standard_parameter_types($parmname);
                   4729:                         if ($type ne '') {
                   4730:                             if (&isdateparm($type)) {
                   4731:                                 $showvalue =
                   4732:                                     &Apache::lonlocal::locallocaltime($value);
                   4733:                             }
                   4734:                         }
                   4735:                     } else {
1.473     amueller 4736:                 if (&isdateparm($istype{$parmname})) {
                   4737:                 $showvalue = 
1.469     raeburn  4738:                                 &Apache::lonlocal::locallocaltime($value);
1.473     amueller 4739:                 }
1.469     raeburn  4740:                     }
                   4741:                     $output .= $showvalue;
1.473     amueller 4742:             if ($value ne $all[$level]) {
                   4743:             $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   4744:             } else {
                   4745:             $stillactive=1;
                   4746:             }
                   4747:         }
                   4748:         }
1.522.2.19  raeburn  4749:         $output .= '</td>';
                   4750: 
                   4751:             unless ($readonly) {
                   4752:                 $output .= '<td>';
                   4753:                 if ($stillactive) {
                   4754:                     my $parmitem = &standard_parameter_names($parmname);
                   4755:                     $parmitem = &mt($parmitem);
                   4756:                     my $title=&mt('Changed [_1]',$parmitem);
                   4757:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   4758:                         $parmitem,$realmdescription,
                   4759:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   4760:                     if (($uname) && ($udom)) {
                   4761:                         $output .=
                   4762:                             &Apache::loncommon::messagewrapper('Notify User',
                   4763:                                                                $uname,$udom,$title,
                   4764:                                                                $description);
                   4765:                     } else {
                   4766:                         $output .=
                   4767:                             &Apache::lonrss::course_blog_link($id,$title,
                   4768:                                                               $description);
                   4769:                     }
                   4770:                 }
                   4771:                 $output .= '</td>';
                   4772:             }
                   4773:         $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 4774:     }
1.349     www      4775:         if ($env{'form.displayfilter'} eq 'containing') {
1.473     amueller 4776:         my $wholeentry=$about_me_link.':'.
                   4777:         $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   4778:         $output;
                   4779:         if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
                   4780:     }
1.349     www      4781:         if ($count) {
1.473     amueller 4782:         $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
1.332     albertel 4783:                        <td rowspan="'.$count.'">'.$about_me_link.
1.473     amueller 4784:           '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   4785:                       ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   4786:           $send_msg_link.'</td>'.$output);
                   4787:         $shown++;
                   4788:     }
                   4789:     if (!($env{'form.show'} eq &mt('all')
                   4790:           || $shown<=$env{'form.show'})) { last; }
1.286     www      4791:     }
1.301     www      4792:     $r->print(&Apache::loncommon::end_data_table());
1.284     www      4793:     $r->print(&Apache::loncommon::end_page());
                   4794: }
                   4795: 
1.437     raeburn  4796: sub update_slots {
                   4797:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   4798:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   4799:     if (!keys(%slot)) {
                   4800:         return 'error: slot does not exist';
                   4801:     }
                   4802:     my $max=$slot{'maxspace'};
                   4803:     if (!defined($max)) { $max=99999; }
                   4804: 
                   4805:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   4806:                                        "^$slot_name\0");
                   4807:     my ($tmp)=%consumed;
                   4808:     if ($tmp=~/^error: 2 / ) {
                   4809:         return 'error: unable to determine current slot status';
                   4810:     }
                   4811:     my $last=0;
                   4812:     foreach my $key (keys(%consumed)) {
                   4813:         my $num=(split('\0',$key))[1];
                   4814:         if ($num > $last) { $last=$num; }
                   4815:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4816:             return 'ok';
                   4817:         }
                   4818:     }
                   4819: 
                   4820:     if (scalar(keys(%consumed)) >= $max) {
                   4821:         return 'error: no space left in slot';
                   4822:     }
                   4823:     my $wanted=$last+1;
                   4824: 
                   4825:     my %reservation=('name'      => $uname.':'.$udom,
                   4826:                      'timestamp' => time,
                   4827:                      'symb'      => $symb);
                   4828: 
                   4829:     my $success=&Apache::lonnet::newput('slot_reservations',
                   4830:                                         {"$slot_name\0$wanted" =>
                   4831:                                              \%reservation},
                   4832:                                         $cdom, $cnum);
1.438     raeburn  4833:     if ($success eq 'ok') {
                   4834:         my %storehash = (
                   4835:                           symb    => $symb,
                   4836:                           slot    => $slot_name,
                   4837:                           action  => 'reserve',
                   4838:                           context => 'parameter',
                   4839:                         );
1.522.2.3  raeburn  4840:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.438     raeburn  4841:                                         '',$uname,$udom,$cnum,$cdom);
                   4842: 
1.522.2.3  raeburn  4843:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.438     raeburn  4844:                                         '',$uname,$udom,$uname,$udom);
                   4845:     }
1.437     raeburn  4846:     return $success;
                   4847: }
                   4848: 
                   4849: sub delete_slots {
                   4850:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   4851:     my $delresult;
                   4852:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   4853:                                          $cnum, "^$slot_name\0");
                   4854:     if (&Apache::lonnet::error(%consumed)) {
                   4855:         return 'error: unable to determine current slot status';
                   4856:     }
                   4857:     my ($tmp)=%consumed;
                   4858:     if ($tmp=~/^error: 2 /) {
                   4859:         return 'error: unable to determine current slot status';
                   4860:     }
                   4861:     foreach my $key (keys(%consumed)) {
                   4862:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4863:             my $num=(split('\0',$key))[1];
                   4864:             my $entry = $slot_name.'\0'.$num;
                   4865:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   4866:                                               $cdom,$cnum);
                   4867:             if ($delresult eq 'ok') {
                   4868:                 my %storehash = (
                   4869:                                   symb    => $symb,
                   4870:                                   slot    => $slot_name,
                   4871:                                   action  => 'release',
                   4872:                                   context => 'parameter',
                   4873:                                 );
1.522.2.3  raeburn  4874:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.437     raeburn  4875:                                                 1,$uname,$udom,$cnum,$cdom);
1.522.2.3  raeburn  4876:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.438     raeburn  4877:                                                 1,$uname,$udom,$uname,$udom);
1.437     raeburn  4878:             }
                   4879:         }
                   4880:     }
                   4881:     return $delresult;
                   4882: }
                   4883: 
1.355     albertel 4884: sub check_for_course_info {
                   4885:     my $navmap = Apache::lonnavmaps::navmap->new();
                   4886:     return 1 if ($navmap);
                   4887:     return 0;
                   4888: }
                   4889: 
1.514     raeburn  4890: sub parameter_release_vars { 
1.504     raeburn  4891:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   4892:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   4893:    my $chostname = &Apache::lonnet::hostname($chome);
                   4894:    my ($cmajor,$cminor) = 
                   4895:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   4896:    return ($chostname,$cmajor,$cminor);
                   4897: }
                   4898: 
1.514     raeburn  4899: sub parameter_releasecheck {
1.522.2.14  raeburn  4900:     my ($name,$value,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  4901:     my $needsnewer;
                   4902:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   4903:     if (($cmajor < $needsmajor) || 
                   4904:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   4905:         $needsnewer = 1;
                   4906:     } else {
1.514     raeburn  4907:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value});
1.504     raeburn  4908:     }
                   4909:     return $needsnewer;
                   4910: }
                   4911: 
                   4912: sub oldversion_warning {
1.514     raeburn  4913:     my ($name,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
1.504     raeburn  4914:     my $desc;
1.514     raeburn  4915:     my %stringtypes = (
1.519     raeburn  4916:                         type         => 'string_questiontype',
                   4917:                         lenient      => 'string_lenient',
                   4918:                         retrypartial => 'string_yesno',
1.521     raeburn  4919:                         discussvote  => 'string_discussvote',
1.522.2.7  raeburn  4920:                         examcode     => 'string_examcode',
1.514     raeburn  4921:                       );
                   4922:     if (exists($stringtypes{$name})) {
1.522.2.7  raeburn  4923:         if ($name eq 'examcode') {
                   4924:             $desc = $value;
                   4925:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
1.514     raeburn  4926:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   4927:                 next unless (ref($possibilities) eq 'ARRAY');
                   4928:                 my ($parmval, $description) = @{ $possibilities };
                   4929:                 if ($parmval eq $value) {
                   4930:                     $desc = $description;
                   4931:                     last;
                   4932:                 }
1.504     raeburn  4933:             }
                   4934:         }
1.522.2.16  raeburn  4935:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   4936:         my $now = time;
                   4937:         if ($value =~ /^\d+$/) {
                   4938:             if ($name eq 'printstartdate') {
                   4939:                 if ($value > $now) {
                   4940:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4941:                 }
                   4942:             } elsif ($name eq 'printenddate') {
                   4943:                 if ($value < $now) {
                   4944:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   4945:                 }
                   4946:             }
                   4947:         }
1.504     raeburn  4948:     }
1.514     raeburn  4949:     my $standard_name = &standard_parameter_names($name);
1.504     raeburn  4950:     return '<p class="LC_warning">'.
1.514     raeburn  4951:            &mt('[_1] was [_2]not[_3] set to [_4].',
                   4952:                $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
1.504     raeburn  4953:            &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   4954:            $cmajor.'.'.$cminor,$chostname,
                   4955:            $needsrelease).
                   4956:            '</p>';
                   4957: }
1.259     banghart 4958: 
1.522.2.19  raeburn  4959: sub get_permission {
                   4960:     my %permission;
                   4961:     my $allowed = 0;
                   4962:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   4963:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   4964:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   4965:                   $env{'request.course.sec'}))) {
                   4966:         %permission= (
                   4967:                        'edit'               => 1,
                   4968:                        'set'                => 1,
                   4969:                        'setoverview'        => 1,
                   4970:                        'addmetadata'        => 1,
                   4971:                        'ordermetadata'      => 1,
                   4972:                        'setrestrictmeta'    => 1,
                   4973:                        'newoverview'        => 1,
                   4974:                        'setdefaults'        => 1,
                   4975:                        'settable'           => 1,
                   4976:                        'parameterchangelog' => 1,
                   4977:                        'cleanparameters'    => 1,
                   4978:                        'dateshift1'         => 1,
                   4979:                        'dateshift2'         => 1,
                   4980:                        'helper'             => 1,
                   4981:          );
                   4982:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   4983:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   4984:                   $env{'request.course.sec'}))) {
                   4985:         %permission = (
                   4986:                        'set'                => 1,
                   4987:                        'settable'           => 1,
                   4988:                        'newoverview'        => 1,
                   4989:                        'setoverview'        => 1,
                   4990:                        'parameterchangelog' => 1,
                   4991:                       );
                   4992:     }
                   4993:     foreach my $perm (values(%permission)) {
                   4994:         if ($perm) { $allowed=1; last; }
                   4995:     }
                   4996:     return (\%permission,$allowed);
                   4997: }
                   4998: 
1.30      www      4999: sub handler {
1.43      albertel 5000:     my $r=shift;
1.30      www      5001: 
1.376     albertel 5002:     &reset_caches();
                   5003: 
1.414     droeschl 5004:     &Apache::loncommon::content_type($r,'text/html');
                   5005:     $r->send_http_header;
                   5006:     return OK if $r->header_only;
                   5007: 
1.193     albertel 5008:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 5009:                         ['action','state',
1.205     www      5010:                                              'pres_marker',
                   5011:                                              'pres_value',
1.206     www      5012:                                              'pres_type',
1.506     www      5013:                                              'filter','part',
1.390     www      5014:                                              'udom','uname','symb','serial','timebase']);
1.131     www      5015: 
1.83      bowersj2 5016: 
1.193     albertel 5017:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 5018:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.522.2.3  raeburn  5019:                         text=>"Content and Problem Settings",
1.473     amueller 5020:                         faq=>10,
                   5021:                         bug=>'Instructor Interface',
1.442     droeschl 5022:                                             help =>
                   5023:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      5024: 
1.30      www      5025: # ----------------------------------------------------- Needs to be in a course
1.522.2.19  raeburn  5026:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 5027:     my $exists = &check_for_course_info();
                   5028: 
1.522.2.19  raeburn  5029:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 5030:         #
                   5031:         # Main switch on form.action and form.state, as appropriate
                   5032:         #
                   5033:         # Check first if coming from someone else headed directly for
                   5034:         #  the table mode
1.522.2.19  raeburn  5035:         if (($parm_permission->{'set'}) &&
                   5036:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   5037:                && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   5038:             &assessparms($r,$parm_permission);
1.193     albertel 5039:         } elsif (! exists($env{'form.action'})) {
                   5040:             &print_main_menu($r,$parm_permission);
1.522.2.19  raeburn  5041:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   5042:             &print_main_menu($r,$parm_permission);
1.414     droeschl 5043:         } elsif ($env{'form.action'} eq 'setoverview') {
1.522.2.19  raeburn  5044:             &overview($r,$parm_permission);
                   5045:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   5046:             &addmetafield($r);
                   5047:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   5048:             &order_meta_fields($r);
1.414     droeschl 5049:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.522.2.19  raeburn  5050:             &setrestrictmeta($r);
1.414     droeschl 5051:         } elsif ($env{'form.action'} eq 'newoverview') {
1.522.2.19  raeburn  5052:             &newoverview($r,$parm_permission);
1.414     droeschl 5053:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.522.2.19  raeburn  5054:             &defaultsetter($r);
                   5055:         } elsif ($env{'form.action'} eq 'settable') {
                   5056:             &assessparms($r,$parm_permission);
1.414     droeschl 5057:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.522.2.19  raeburn  5058:             &parm_change_log($r,$parm_permission);
1.414     droeschl 5059:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.522.2.19  raeburn  5060:             &clean_parameters($r);
1.414     droeschl 5061:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      5062:             &date_shift_one($r);
1.414     droeschl 5063:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      5064:             &date_shift_two($r);
1.446     bisitz   5065:         }
1.43      albertel 5066:     } else {
1.1       www      5067: # ----------------------------- Not in a course, or not allowed to modify parms
1.473     amueller 5068:     if ($exists) {
                   5069:         $env{'user.error.msg'}=
                   5070:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   5071:     } else {
                   5072:         $env{'user.error.msg'}=
                   5073:         "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   5074:     }
                   5075:     return HTTP_NOT_ACCEPTABLE;
1.43      albertel 5076:     }
1.376     albertel 5077:     &reset_caches();
                   5078: 
1.43      albertel 5079:     return OK;
1.1       www      5080: }
                   5081: 
                   5082: 1;
                   5083: __END__
                   5084: 
                   5085: 

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