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

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

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