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

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

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