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

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

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