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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.463   ! bisitz      4: # $Id: lonparmset.pm,v 1.462 2009/06/18 19:43:14 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.463   ! bisitz   1630:         $r->print(&Apache::loncommon::start_data_table()
        !          1631:                  .&Apache::loncommon::start_data_table_row()
        !          1632:                  .'<td>'.$icon
        !          1633:                  .'<label>&nbsp;'
        !          1634:                  .'<input type="radio" name="pschp" checked="checked" value="all" />'
        !          1635:                  .&mt('All Maps or Folders')
        !          1636:                  .'</label></td>'
        !          1637:                  .&Apache::loncommon::end_data_table_row()
        !          1638:         );
1.461     neumanie 1639:         foreach my $mapid (@{$tree}) {
                   1640:             my $depth = $treeinfo->{$mapid}->{'depth'};
                   1641:             my $indent = ('&nbsp;'x$depth);
                   1642:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
                   1643:             if ($treeinfo->{$mapid}->{'type'} eq 'page') {
                   1644:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   1645:             }
1.463   ! bisitz   1646:             $r->print(&Apache::loncommon::start_data_table_row()
        !          1647:                      .'<td>'.$indent.$icon
        !          1648:                      .'<label>&nbsp;'
        !          1649:                      .'<input type ="radio" name="pschp" value="'.$mapid.'"'
        !          1650:             );
1.461     neumanie 1651:             if ($pschp eq $mapid) {
                   1652:                 $r->print(' checked="checked"');
                   1653:             }
1.463   ! bisitz   1654:             $r->print('/>'
        !          1655:                      .$$maptitles{$mapid}
        !          1656:                      .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
        !          1657:                      .'</label>'
        !          1658:                      .'</td>'
        !          1659:                      .&Apache::loncommon::end_data_table_row()
        !          1660:             );
1.461     neumanie 1661:         }
1.462     neumanie 1662:         $r->print(&Apache::loncommon::end_data_table());
1.209     www      1663:     }
                   1664: }
                   1665: 
                   1666: sub levelmenu {
1.446     bisitz   1667:     my ($r,$alllevs,$parmlev)=@_;
                   1668: 
1.445     neumanie 1669:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').&Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.209     www      1670:     $r->print('<select name="parmlev">');
                   1671:     foreach (reverse sort keys %{$alllevs}) {
                   1672: 	$r->print('<option value="'.$$alllevs{$_}.'"');
                   1673: 	if ($parmlev eq $$alllevs{$_}) {
1.446     bisitz   1674: 	    $r->print(' selected="selected"');
1.209     www      1675: 	}
1.401     bisitz   1676: 	$r->print('>'.&mt($_).'</option>');
1.208     www      1677:     }
1.446     bisitz   1678:     $r->print("</select>");
1.208     www      1679: }
                   1680: 
1.211     www      1681: 
                   1682: sub sectionmenu {
                   1683:     my ($r,$selectedsections)=@_;
1.300     albertel 1684:     my %sectionhash = &Apache::loncommon::get_sections();
                   1685:     return if (!%sectionhash);
                   1686: 
1.421     bisitz   1687:     $r->print('<select name="Section" multiple="multiple" size="8">');
1.300     albertel 1688:     foreach my $s ('all',sort keys %sectionhash) {
                   1689: 	$r->print('    <option value="'.$s.'"');
                   1690: 	foreach (@{$selectedsections}) {
                   1691: 	    if ($s eq $_) {
1.401     bisitz   1692: 		$r->print(' selected="selected"');
1.300     albertel 1693: 		last;
1.212     www      1694: 	    }
                   1695: 	}
1.300     albertel 1696: 	$r->print('>'.$s."</option>\n");
                   1697:     }
                   1698:     $r->print("</select>\n");
1.269     raeburn  1699: }
                   1700: 
                   1701: sub groupmenu {
                   1702:     my ($r,$selectedgroups)=@_;
1.307     raeburn  1703:     my %grouphash = &Apache::longroup::coursegroups();
1.299     albertel 1704:     return if (!%grouphash);
                   1705: 
1.421     bisitz   1706:     $r->print('<select name="Group" multiple="multiple" size="8">');
1.299     albertel 1707:     foreach my $group (sort(keys(%grouphash))) {
                   1708: 	$r->print('    <option value="'.$group.'"');
                   1709: 	foreach (@{$selectedgroups}) {
                   1710: 	    if ($group eq $_) {
1.401     bisitz   1711: 		$r->print(' selected="selected"');
1.299     albertel 1712: 		last;
                   1713: 	    }
                   1714: 	}
                   1715: 	$r->print('>'.$group."</option>\n");
1.211     www      1716:     }
1.299     albertel 1717:     $r->print("</select>\n");
1.211     www      1718: }
                   1719: 
1.269     raeburn  1720: 
1.210     www      1721: sub keysplit {
                   1722:     my $keyp=shift;
                   1723:     return (split(/\,/,$keyp));
                   1724: }
                   1725: 
                   1726: sub keysinorder {
                   1727:     my ($name,$keyorder)=@_;
                   1728:     return sort {
                   1729: 	$$keyorder{$a} <=> $$keyorder{$b};
                   1730:     } (keys %{$name});
                   1731: }
                   1732: 
1.236     albertel 1733: sub keysinorder_bytype {
                   1734:     my ($name,$keyorder)=@_;
                   1735:     return sort {
                   1736: 	my $ta=(split('_',$a))[-1];
                   1737: 	my $tb=(split('_',$b))[-1];
                   1738: 	if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   1739: 	    return ($a cmp $b);
                   1740: 	}
                   1741: 	$$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
                   1742:     } (keys %{$name});
                   1743: }
                   1744: 
1.211     www      1745: sub keysindisplayorder {
                   1746:     my ($name,$keyorder)=@_;
                   1747:     return sort {
                   1748: 	$$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
                   1749:     } (keys %{$name});
                   1750: }
                   1751: 
1.214     www      1752: sub sortmenu {
                   1753:     my ($r,$sortorder)=@_;
1.236     albertel 1754:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      1755:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   1756:        $r->print(' checked="checked"');
1.214     www      1757:     }
                   1758:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 1759:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      1760:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   1761:        $r->print(' checked="checked"');
1.214     www      1762:     }
1.236     albertel 1763:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
                   1764: 	      '</label>');
1.214     www      1765: }
                   1766: 
1.211     www      1767: sub standardkeyorder {
                   1768:     return ('parameter_0_opendate' => 1,
                   1769: 	    'parameter_0_duedate' => 2,
                   1770: 	    'parameter_0_answerdate' => 3,
                   1771: 	    'parameter_0_interval' => 4,
                   1772: 	    'parameter_0_weight' => 5,
                   1773: 	    'parameter_0_maxtries' => 6,
                   1774: 	    'parameter_0_hinttries' => 7,
                   1775: 	    'parameter_0_contentopen' => 8,
                   1776: 	    'parameter_0_contentclose' => 9,
                   1777: 	    'parameter_0_type' => 10,
                   1778: 	    'parameter_0_problemstatus' => 11,
                   1779: 	    'parameter_0_hiddenresource' => 12,
                   1780: 	    'parameter_0_hiddenparts' => 13,
                   1781: 	    'parameter_0_display' => 14,
                   1782: 	    'parameter_0_ordered' => 15,
                   1783: 	    'parameter_0_tol' => 16,
                   1784: 	    'parameter_0_sig' => 17,
1.218     www      1785: 	    'parameter_0_turnoffunit' => 18,
                   1786:             'parameter_0_discussend' => 19,
                   1787:             'parameter_0_discusshide' => 20);
1.211     www      1788: }
                   1789: 
1.59      matthew  1790: 
1.30      www      1791: sub assessparms {
1.1       www      1792: 
1.43      albertel 1793:     my $r=shift;
1.201     www      1794: 
                   1795:     my @ids=();
                   1796:     my %symbp=();
                   1797:     my %mapp=();
                   1798:     my %typep=();
                   1799:     my %keyp=();
                   1800:     my %uris=();
                   1801:     my %maptitles=();
                   1802: 
1.2       www      1803: # -------------------------------------------------------- Variable declaration
1.209     www      1804: 
1.129     www      1805:     my %allmaps=();
                   1806:     my %alllevs=();
1.57      albertel 1807: 
1.187     www      1808:     my $uname;
                   1809:     my $udom;
                   1810:     my $uhome;
                   1811:     my $csec;
1.269     raeburn  1812:     my $cgroup;
1.275     raeburn  1813:     my @usersgroups = ();
1.446     bisitz   1814: 
1.190     albertel 1815:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      1816: 
1.57      albertel 1817:     $alllevs{'Resource Level'}='full';
1.215     www      1818:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 1819:     $alllevs{'Course Level'}='general';
                   1820: 
                   1821:     my %allparms;
                   1822:     my %allparts;
1.210     www      1823: #
                   1824: # Order in which these parameters will be displayed
                   1825: #
1.211     www      1826:     my %keyorder=&standardkeyorder();
                   1827: 
1.43      albertel 1828:     @ids=();
                   1829:     %symbp=();
                   1830:     %typep=();
                   1831: 
                   1832:     my $message='';
                   1833: 
1.190     albertel 1834:     $csec=$env{'form.csec'};
1.269     raeburn  1835:     $cgroup=$env{'form.cgroup'};
1.188     www      1836: 
1.190     albertel 1837:     if      ($udom=$env{'form.udom'}) {
                   1838:     } elsif ($udom=$env{'request.role.domain'}) {
                   1839:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 1840:     } else {
                   1841: 	$udom=$r->dir_config('lonDefDomain');
                   1842:     }
1.43      albertel 1843: 
1.134     albertel 1844:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 1845:     my $pschp=$env{'form.pschp'};
1.134     albertel 1846:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76      www      1847:     if (!@psprt) { $psprt[0]='0'; }
1.57      albertel 1848: 
1.43      albertel 1849:     my $pssymb='';
1.57      albertel 1850:     my $parmlev='';
1.446     bisitz   1851: 
1.190     albertel 1852:     unless ($env{'form.parmlev'}) {
1.57      albertel 1853:         $parmlev = 'map';
                   1854:     } else {
1.190     albertel 1855:         $parmlev = $env{'form.parmlev'};
1.57      albertel 1856:     }
1.26      www      1857: 
1.29      www      1858: # ----------------------------------------------- Was this started from grades?
                   1859: 
1.190     albertel 1860:     if (($env{'form.command'} eq 'set') && ($env{'form.url'})
                   1861: 	&& (!$env{'form.dis'})) {
                   1862: 	my $url=$env{'form.url'};
1.194     albertel 1863: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.43      albertel 1864: 	$pssymb=&Apache::lonnet::symbread($url);
1.92      albertel 1865: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1866: 	$pschp='';
1.57      albertel 1867:         $parmlev = 'full';
1.190     albertel 1868:     } elsif ($env{'form.symb'}) {
                   1869: 	$pssymb=$env{'form.symb'};
1.92      albertel 1870: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1871: 	$pschp='';
1.57      albertel 1872:         $parmlev = 'full';
1.43      albertel 1873:     } else {
1.190     albertel 1874: 	$env{'form.url'}='';
1.43      albertel 1875:     }
                   1876: 
1.190     albertel 1877:     my $id=$env{'form.id'};
1.43      albertel 1878:     if (($id) && ($udom)) {
                   1879: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                   1880: 	if ($uname) {
                   1881: 	    $id='';
                   1882: 	} else {
                   1883: 	    $message=
1.314     albertel 1884: 		'<span class="LC_error">'.&mt("Unknown ID")." '$id' ".
                   1885: 		&mt('at domain')." '$udom'</span>";
1.43      albertel 1886: 	}
                   1887:     } else {
1.190     albertel 1888: 	$uname=$env{'form.uname'};
1.43      albertel 1889:     }
                   1890:     unless ($udom) { $uname=''; }
                   1891:     $uhome='';
                   1892:     if ($uname) {
                   1893: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                   1894:         if ($uhome eq 'no_host') {
                   1895: 	    $message=
1.314     albertel 1896: 		'<span class="LC_error">'.&mt("Unknown user")." '$uname' ".
                   1897: 		&mt("at domain")." '$udom'</span>";
1.43      albertel 1898: 	    $uname='';
1.12      www      1899:         } else {
1.103     albertel 1900: 	    $csec=&Apache::lonnet::getsection($udom,$uname,
1.190     albertel 1901: 					      $env{'request.course.id'});
1.446     bisitz   1902: 
1.43      albertel 1903: 	    if ($csec eq '-1') {
1.314     albertel 1904: 		$message='<span class="LC_error">'.
1.133     www      1905: 		    &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
1.314     albertel 1906: 		    &mt("not in this course")."</span>";
1.43      albertel 1907: 		$uname='';
1.190     albertel 1908: 		$csec=$env{'form.csec'};
1.269     raeburn  1909:                 $cgroup=$env{'form.cgroup'};
1.43      albertel 1910: 	    } else {
                   1911: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1912: 		      ('firstname','middlename','lastname','generation','id'));
1.133     www      1913: 		$message="\n<p>\n".&mt("Full Name").": ".
1.43      albertel 1914: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                   1915: 			.$name{'lastname'}.' '.$name{'generation'}.
1.336     albertel 1916: 			    "<br />\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43      albertel 1917: 	    }
1.297     raeburn  1918:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  1919:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  1920:             if (@usersgroups > 0) {
1.306     albertel 1921:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  1922:                     $cgroup = $usersgroups[0];
1.297     raeburn  1923:                 }
1.269     raeburn  1924:             }
1.12      www      1925:         }
1.43      albertel 1926:     }
1.2       www      1927: 
1.43      albertel 1928:     unless ($csec) { $csec=''; }
1.269     raeburn  1929:     unless ($cgroup) { $cgroup=''; }
1.12      www      1930: 
1.14      www      1931: # --------------------------------------------------------- Get all assessments
1.446     bisitz   1932:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.210     www      1933: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   1934: 				\%keyorder);
1.63      bowersj2 1935: 
1.57      albertel 1936:     $mapp{'0.0'} = '';
                   1937:     $symbp{'0.0'} = '';
1.99      albertel 1938: 
1.14      www      1939: # ---------------------------------------------------------- Anything to store?
1.190     albertel 1940:     if ($env{'form.pres_marker'}) {
1.205     www      1941:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   1942:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   1943:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
                   1944: 	for (my $i=0;$i<=$#markers;$i++) {
1.437     raeburn  1945:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3)$/) {
                   1946:                 my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1947:                 my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   1948:                 my (@ok_slots,@fail_slots,@del_slots);
                   1949:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   1950:                 my ($level,@all) =
                   1951:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   1952:                                      $csec,$cgroup,$courseopt);
                   1953:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   1954:                     next if ($slot_name eq '');
                   1955:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   1956:                         push(@ok_slots,$slot_name);
                   1957: 
                   1958:                     } else {
                   1959:                         push(@fail_slots,$slot_name);
                   1960:                     }
                   1961:                 }
                   1962:                 if (@ok_slots) {
                   1963:                     $values[$i] = join(':',@ok_slots);
                   1964:                 } else {
                   1965:                     $values[$i] = '';
                   1966:                 }
                   1967:                 if ($all[$level] ne '') {
                   1968:                     my @existing = split(/:/,$all[$level]);
                   1969:                     foreach my $slot_name (@existing) {
                   1970:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   1971:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   1972:                                 push(@del_slots,$slot_name);
                   1973:                             }
                   1974:                         }
                   1975:                     }
                   1976:                 }
                   1977:             }
1.205     www      1978: 	    $message.=&storeparm(split(/\&/,$markers[$i]),
                   1979: 				 $values[$i],
                   1980: 				 $types[$i],
1.269     raeburn  1981: 				 $uname,$udom,$csec,$cgroup);
1.205     www      1982: 	}
1.68      www      1983: # ---------------------------------------------------------------- Done storing
1.459     bisitz   1984:         $message.='<p class="LC_warning">'
                   1985:                  .&mt('Changes can take up to 10 minutes before being active for all students.')
                   1986:                  .&Apache::loncommon::help_open_topic('Caching')
                   1987:                  .'</p>';
1.68      www      1988:     }
1.57      albertel 1989: #----------------------------------------------- if all selected, fill in array
1.209     www      1990:     if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
1.446     bisitz   1991:     if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries') };
1.57      albertel 1992:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www      1993: # ------------------------------------------------------------------ Start page
1.63      bowersj2 1994: 
1.209     www      1995:     &startpage($r);
1.57      albertel 1996: 
1.44      albertel 1997:     foreach ('tolerance','date_default','date_start','date_end',
                   1998: 	     'date_interval','int','float','string') {
                   1999: 	$r->print('<input type="hidden" value="'.
1.378     albertel 2000: 		  &HTML::Entities::encode($env{'form.recent_'.$_},'"&<>').
                   2001: 		  '" name="recent_'.$_.'" />');
1.44      albertel 2002:     }
1.446     bisitz   2003: 
1.459     bisitz   2004:     # ----- Start Parameter Selection
                   2005: 
                   2006:     # Hide parm selection?
                   2007:     $r->print(<<ENDPARMSELSCRIPT);
                   2008: <script type="text/javascript">
                   2009: // <![CDATA[
                   2010: function parmsel_show() {
                   2011:   document.getElementById('parmsel').style.display = "";
                   2012:   document.getElementById('parmsellink').style.display = "none";
                   2013: }
                   2014: // ]]>
                   2015: </script>
                   2016: ENDPARMSELSCRIPT
                   2017:     my $parmselhiddenstyle=' style="display:none"';
                   2018:     if($env{'form.hideparmsel'} eq 'hidden') {
                   2019:         $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   2020:     } else  {
                   2021:         $r->print('<div id="parmsel">');
                   2022:     }
                   2023: 
                   2024:     # Display parameter selection boxes
1.445     neumanie 2025:     if (!$pssymb) {
1.449     neumanie 2026:         $r->print(&Apache::lonhtmlcommon::topic_bar (1,&mt('General Parameters')));
1.445     neumanie 2027:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   2028: 
1.209     www      2029:         &levelmenu($r,\%alllevs,$parmlev);
1.446     bisitz   2030: 
                   2031: 	if ($parmlev ne 'general') {
1.447     bisitz   2032:             $r->print(&Apache::lonhtmlcommon::row_closure());
1.446     bisitz   2033: 	    &mapmenu($r,\%allmaps,$pschp,\%maptitles);
1.445     neumanie 2034: 	}
1.446     bisitz   2035: 
1.447     bisitz   2036:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.446     bisitz   2037:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.449     neumanie 2038:        
1.211     www      2039: 	&displaymenu($r,\%allparms,\%allparts,\@pscat,\@psprt,\%keyorder);
1.44      albertel 2040:     } else {
1.125     www      2041:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.312     albertel 2042: 	my $title = &Apache::lonnet::gettitle($pssymb);
                   2043:         $r->print(&mt('Specific Resource: [_1] ([_2])',$title,$resource).
                   2044:                   '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.238     www      2045: 		  '<br /><label><b>'.&mt('Show all parts').': <input type="checkbox" name="psprt" value="all"'.
                   2046: 		  ($env{'form.psprt'}?' checked="checked"':'').' /></b></label><br />');
1.57      albertel 2047:     }
1.449     neumanie 2048:     $r->print(&Apache::lonhtmlcommon::topic_bar (3,&mt('User Selection')));
1.445     neumanie 2049:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
                   2050:     &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);
1.447     bisitz   2051:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 2052:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.449     neumanie 2053:     
1.459     bisitz   2054:     # parm selection is shown: display parm update button
                   2055:     $r->print('<p>'
                   2056:              .'<input type="submit" name="dis"'
                   2057:              .' value="'.&mt('Update Parameter Display').'" />'
                   2058:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   2059:              .'</p>'
                   2060:     );
                   2061: 
                   2062:     $r->print('</div>');
                   2063:     # ----- End Parameter Selection
                   2064: 
                   2065:     # Offer link to display parameter selection again
                   2066:     $r->print('<p id="parmsellink"');
                   2067:     if($env{'form.hideparmsel'} ne 'hidden') {
                   2068:         $r->print($parmselhiddenstyle);
                   2069:     }
                   2070:     $r->print('>'
                   2071:              .'<a href="javascript:parmsel_show()">'
                   2072:              .&mt('Change Parameter Selection')
                   2073:              .'</a>'
                   2074:              .'</p>');
1.57      albertel 2075: 
1.459     bisitz   2076:     # Display Messages
                   2077:     $r->print('<div>'.$message.'</div>');
1.210     www      2078: 
1.57      albertel 2079: 
                   2080:     my @temp_pscat;
                   2081:     map {
                   2082:         my $cat = $_;
                   2083:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   2084:     } @pscat;
                   2085: 
                   2086:     @pscat = @temp_pscat;
                   2087: 
1.209     www      2088:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      2089: # ----------------------------------------------------------------- Start Table
1.57      albertel 2090:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 2091:         my $csuname=$env{'user.name'};
                   2092:         my $csudom=$env{'user.domain'};
1.57      albertel 2093: 
1.203     www      2094:         if ($parmlev eq 'full') {
1.57      albertel 2095:            my $coursespan=$csec?8:5;
1.275     raeburn  2096:            my $userspan=3;
1.269     raeburn  2097:            if ($cgroup ne '') {
                   2098:               $coursespan += 3;
1.446     bisitz   2099:            }
                   2100: 
1.419     bisitz   2101:            $r->print('<p><table border="2">');
                   2102:            $r->print('<tr><td colspan="5"></td>');
                   2103:            $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
1.57      albertel 2104:            if ($uname) {
1.275     raeburn  2105:                if (@usersgroups > 1) {
                   2106:                    $userspan ++;
                   2107:                }
                   2108:                $r->print('<th colspan="'.$userspan.'" rowspan="2">');
1.130     www      2109:                $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57      albertel 2110:            }
1.133     www      2111: 	   my %lt=&Apache::lonlocal::texthash(
                   2112: 				  'pie'    => "Parameter in Effect",
                   2113: 				  'csv'    => "Current Session Value",
                   2114:                                   'at'     => 'at',
                   2115:                                   'rl'     => "Resource Level",
                   2116: 				  'ic'     => 'in Course',
                   2117: 				  'aut'    => "Assessment URL and Title",
1.143     albertel 2118: 				  'type'   => 'Type',
1.133     www      2119: 				  'emof'   => "Enclosing Map or Folder",
1.143     albertel 2120: 				  'part'   => 'Part',
1.133     www      2121:                                   'pn'     => 'Parameter Name',
                   2122: 				  'def'    => 'default',
                   2123: 				  'femof'  => 'from Enclosing Map or Folder',
                   2124: 				  'gen'    => 'general',
                   2125: 				  'foremf' => 'for Enclosing Map or Folder',
                   2126: 				  'fr'     => 'for Resource'
                   2127: 					      );
1.57      albertel 2128:            $r->print(<<ENDTABLETWO);
1.419     bisitz   2129: <th rowspan="3">$lt{'pie'}</th>
                   2130: <th rowspan="3">$lt{'csv'}<br />($csuname $lt{'at'} $csudom)</th>
                   2131: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
                   2132: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 2133: 
1.10      www      2134: ENDTABLETWO
1.57      albertel 2135:            if ($csec) {
1.419     bisitz   2136:                 $r->print('<th colspan="3">'.
1.269     raeburn  2137: 			  &mt("in Section")." $csec</th>");
                   2138:            }
                   2139:            if ($cgroup) {
1.419     bisitz   2140:                 $r->print('<th colspan="3">'.
1.269     raeburn  2141:                           &mt("in Group")." $cgroup</th>");
1.57      albertel 2142:            }
                   2143:            $r->print(<<ENDTABLEHEADFOUR);
1.133     www      2144: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   2145: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 2146: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   2147: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      2148: ENDTABLEHEADFOUR
1.57      albertel 2149: 
                   2150:            if ($csec) {
1.130     www      2151:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 2152:            }
                   2153: 
1.269     raeburn  2154:            if ($cgroup) {
                   2155:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   2156:            }
                   2157: 
1.57      albertel 2158:            if ($uname) {
1.275     raeburn  2159:                if (@usersgroups > 1) {
                   2160:                    $r->print('<th>'.&mt('Control by other group?').'</th>');
                   2161:                }
1.130     www      2162:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 2163:            }
                   2164: 
                   2165:            $r->print('</tr>');
                   2166: 
                   2167:            my $defbgone='';
                   2168:            my $defbgtwo='';
1.269     raeburn  2169:            my $defbgthree = '';
1.57      albertel 2170: 
                   2171:            foreach (@ids) {
                   2172: 
                   2173:                 my $rid=$_;
                   2174:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   2175: 
1.446     bisitz   2176:                 if ((!$pssymb &&
1.152     albertel 2177: 		     (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   2178: 		    ||
                   2179: 		    ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      2180: # ------------------------------------------------------ Entry for one resource
1.419     bisitz   2181:                     if ($defbgone eq '#E0E099') {
                   2182:                         $defbgone='#E0E0DD';
1.57      albertel 2183:                     } else {
1.419     bisitz   2184:                         $defbgone='#E0E099';
1.57      albertel 2185:                     }
1.419     bisitz   2186:                     if ($defbgtwo eq '#FFFF99') {
                   2187:                         $defbgtwo='#FFFFDD';
1.57      albertel 2188:                     } else {
1.419     bisitz   2189:                         $defbgtwo='#FFFF99';
1.57      albertel 2190:                     }
1.419     bisitz   2191:                     if ($defbgthree eq '#FFBB99') {
                   2192:                         $defbgthree='#FFBBDD';
1.269     raeburn  2193:                     } else {
1.419     bisitz   2194:                         $defbgthree='#FFBB99';
1.269     raeburn  2195:                     }
                   2196: 
1.57      albertel 2197:                     my $thistitle='';
                   2198:                     my %name=   ();
                   2199:                     undef %name;
                   2200:                     my %part=   ();
                   2201:                     my %display=();
                   2202:                     my %type=   ();
                   2203:                     my %default=();
1.196     www      2204:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2205: 
1.210     www      2206:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2207:                         my $tempkeyp = $_;
                   2208:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   2209:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   2210:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
1.433     raeburn  2211:                           my $parmdis=&Apache::lonnet::metadata($uri,$_.'.display');
                   2212:                           if ($allparms{$name{$_}} ne '') {
                   2213:                               my $identifier;
                   2214:                               if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2215:                                   $identifier = $1;
                   2216:                               }
                   2217:                               $display{$_} = $allparms{$name{$_}}.$identifier;
                   2218:                           } else {
                   2219:                               $display{$_} = $parmdis;
                   2220:                           }
1.57      albertel 2221:                           unless ($display{$_}) { $display{$_}=''; }
                   2222:                           $display{$_}.=' ('.$name{$_}.')';
                   2223:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   2224:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   2225:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   2226:                         }
                   2227:                     }
                   2228:                     my $totalparms=scalar keys %name;
                   2229:                     if ($totalparms>0) {
                   2230:                         my $firstrow=1;
1.274     albertel 2231: 			my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419     bisitz   2232:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 2233:                              ' rowspan='.$totalparms.
1.419     bisitz   2234:                              '><tt><font size="-1">'.
1.57      albertel 2235:                              join(' / ',split(/\//,$uri)).
                   2236:                              '</font></tt><p><b>'.
1.154     albertel 2237:                              "<a href=\"javascript:openWindow('".
1.274     albertel 2238: 				  &Apache::lonnet::clutter($uri).'?symb='.
1.308     www      2239: 				  &escape($symbp{$rid}).
1.336     albertel 2240:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   2241:                              " target=\"_self\">$title");
1.57      albertel 2242: 
                   2243:                         if ($thistitle) {
                   2244:                             $r->print(' ('.$thistitle.')');
                   2245:                         }
                   2246:                         $r->print('</a></b></td>');
1.419     bisitz   2247:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 2248:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   2249:                                       '</td>');
                   2250: 
1.419     bisitz   2251:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 2252:                                       ' rowspan='.$totalparms.
1.238     www      2253:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.57      albertel 2254: 
1.236     albertel 2255:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 2256:                             unless ($firstrow) {
                   2257:                                 $r->print('<tr>');
                   2258:                             } else {
                   2259:                                 undef $firstrow;
                   2260:                             }
1.201     www      2261:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 2262:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  2263:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.275     raeburn  2264:                                                             $cgroup,\@usersgroups);
1.57      albertel 2265:                         }
                   2266:                     }
                   2267:                 }
                   2268:             } # end foreach ids
1.43      albertel 2269: # -------------------------------------------------- End entry for one resource
1.57      albertel 2270:             $r->print('</table>');
1.203     www      2271:         } # end of  full
1.57      albertel 2272: #--------------------------------------------------- Entry for parm level map
                   2273:         if ($parmlev eq 'map') {
1.419     bisitz   2274:             my $defbgone = '#E0E099';
                   2275:             my $defbgtwo = '#FFFF99';
                   2276:             my $defbgthree = '#FFBB99';
1.57      albertel 2277: 
                   2278:             my %maplist;
                   2279: 
                   2280:             if ($pschp eq 'all') {
1.446     bisitz   2281:                 %maplist = %allmaps;
1.57      albertel 2282:             } else {
                   2283:                 %maplist = ($pschp => $mapp{$pschp});
                   2284:             }
                   2285: 
                   2286: #-------------------------------------------- for each map, gather information
                   2287:             my $mapid;
1.60      albertel 2288: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   2289:                 my $maptitle = $maplist{$mapid};
1.57      albertel 2290: 
                   2291: #-----------------------  loop through ids and get all parameter types for map
                   2292: #-----------------------------------------          and associated information
                   2293:                 my %name = ();
                   2294:                 my %part = ();
                   2295:                 my %display = ();
                   2296:                 my %type = ();
                   2297:                 my %default = ();
                   2298:                 my $map = 0;
                   2299: 
                   2300: #		$r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   2301: 
1.57      albertel 2302:                 foreach (@ids) {
                   2303:                   ($map)=(/([\d]*?)\./);
                   2304:                   my $rid = $_;
1.446     bisitz   2305: 
1.57      albertel 2306: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   2307: 
                   2308:                   if ($map eq $mapid) {
1.196     www      2309:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2310: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   2311: 
                   2312: #--------------------------------------------------------------------
                   2313: # @catmarker contains list of all possible parameters including part #s
                   2314: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2315: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2316: # When storing information, store as part 0
                   2317: # When requesting information, request from full part
                   2318: #-------------------------------------------------------------------
1.210     www      2319:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2320:                       my $tempkeyp = $_;
                   2321:                       my $fullkeyp = $tempkeyp;
1.73      albertel 2322:                       $tempkeyp =~ s/_\w+_/_0_/;
1.446     bisitz   2323: 
1.57      albertel 2324:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2325:                         $part{$tempkeyp}="0";
                   2326:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1.433     raeburn  2327:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2328:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   2329:                             my $identifier;
                   2330:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2331:                                 $identifier = $1;
                   2332:                             }
                   2333:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2334:                         } else {
                   2335:                             $display{$tempkeyp} = $parmdis;
                   2336:                         }
1.57      albertel 2337:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2338:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 2339:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 2340:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2341:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2342:                       }
                   2343:                     } # end loop through keys
                   2344:                   }
                   2345:                 } # end loop through ids
1.446     bisitz   2346: 
1.57      albertel 2347: #---------------------------------------------------- print header information
1.133     www      2348:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      2349:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   2350:                 my $tmp="";
1.57      albertel 2351:                 if ($uname) {
1.267     albertel 2352: 		    my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   2353:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   2354:                         &mt('in')." \n";
1.57      albertel 2355:                 } else {
1.401     bisitz   2356:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 2357:                 }
1.269     raeburn  2358:                 if ($cgroup) {
1.401     bisitz   2359:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   2360:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2361:                     $csec = '';
                   2362:                 } elsif ($csec) {
1.401     bisitz   2363:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   2364:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  2365:                 }
1.401     bisitz   2366:                 $r->print('<div align="center"><h4>'
                   2367:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   2368:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   2369:                              ,$tmp
                   2370:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   2371:                              )
                   2372:                          ."<br /></h4>\n"
1.422     bisitz   2373:                 );
1.57      albertel 2374: #---------------------------------------------------------------- print table
1.419     bisitz   2375:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2376:                          .&Apache::loncommon::start_data_table_header_row()
                   2377:                          .'<th>'.&mt('Parameter Name').'</th>'
                   2378:                          .'<th>'.&mt('Default Value').'</th>'
                   2379:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   2380:                          .&Apache::loncommon::end_data_table_header_row()
                   2381:                 );
1.57      albertel 2382: 
1.210     www      2383: 	        foreach (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   2384:                     $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2385:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2386:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2387:                            $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 2388:                 }
1.422     bisitz   2389:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   2390:                          .'</div>'
                   2391:                 );
1.57      albertel 2392:             } # end each map
                   2393:         } # end of $parmlev eq map
                   2394: #--------------------------------- Entry for parm level general (Course level)
                   2395:         if ($parmlev eq 'general') {
1.419     bisitz   2396:             my $defbgone = '#E0E099';
                   2397:             my $defbgtwo = '#FFFF99';
                   2398:             my $defbgthree = '#FFBB99';
1.57      albertel 2399: 
                   2400: #-------------------------------------------- for each map, gather information
                   2401:             my $mapid="0.0";
                   2402: #-----------------------  loop through ids and get all parameter types for map
                   2403: #-----------------------------------------          and associated information
                   2404:             my %name = ();
                   2405:             my %part = ();
                   2406:             my %display = ();
                   2407:             my %type = ();
                   2408:             my %default = ();
1.446     bisitz   2409: 
1.57      albertel 2410:             foreach (@ids) {
                   2411:                 my $rid = $_;
1.446     bisitz   2412: 
1.196     www      2413:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 2414: 
                   2415: #--------------------------------------------------------------------
                   2416: # @catmarker contains list of all possible parameters including part #s
                   2417: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   2418: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   2419: # When storing information, store as part 0
                   2420: # When requesting information, request from full part
                   2421: #-------------------------------------------------------------------
1.210     www      2422:                 foreach (&keysplit($keyp{$rid})) {
1.57      albertel 2423:                   my $tempkeyp = $_;
                   2424:                   my $fullkeyp = $tempkeyp;
1.73      albertel 2425:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 2426:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   2427:                     $part{$tempkeyp}="0";
                   2428:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1.433     raeburn  2429:                     my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   2430:                     if ($allparms{$name{$tempkeyp}} ne '') {
                   2431:                         my $identifier;
                   2432:                         if ($parmdis =~ /(\s*\[Part.*)$/) {
                   2433:                             $identifier = $1;
                   2434:                         }
                   2435:                         $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   2436:                     } else {
                   2437:                         $display{$tempkeyp} = $parmdis;
                   2438:                     }
1.57      albertel 2439:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   2440:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 2441:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 2442:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   2443:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   2444:                   }
                   2445:                 } # end loop through keys
                   2446:             } # end loop through ids
1.446     bisitz   2447: 
1.57      albertel 2448: #---------------------------------------------------- print header information
1.133     www      2449: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 2450:             $r->print(<<ENDMAPONE);
1.419     bisitz   2451: <center>
                   2452: <h4>$setdef
1.135     albertel 2453: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 2454: ENDMAPONE
                   2455:             if ($uname) {
1.267     albertel 2456: 		my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 2457:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 2458:             } else {
1.135     albertel 2459:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 2460:             }
1.446     bisitz   2461: 
1.135     albertel 2462:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 2463:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 2464:             $r->print("</h4>\n");
1.57      albertel 2465: #---------------------------------------------------------------- print table
1.419     bisitz   2466:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   2467:                      .&Apache::loncommon::start_data_table_header_row()
                   2468:                      .'<th>'.&mt('Parameter Name').'</th>'
                   2469:                      .'<th>'.&mt('Default Value').'</th>'
                   2470:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   2471:                      .&Apache::loncommon::end_data_table_header_row()
                   2472:             );
1.57      albertel 2473: 
1.210     www      2474: 	    foreach (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   2475:                 $r->print(&Apache::loncommon::start_data_table_row());
1.201     www      2476:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  2477:                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   2478:                                    $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 2479:             }
1.419     bisitz   2480:             $r->print(&Apache::loncommon::end_data_table()
                   2481:                      .'</p>'
                   2482:                      .'</center>'
                   2483:             );
1.57      albertel 2484:         } # end of $parmlev eq general
1.43      albertel 2485:     }
1.280     albertel 2486:     $r->print('</form>'.&Apache::loncommon::end_page());
1.57      albertel 2487: } # end sub assessparms
1.30      www      2488: 
1.120     www      2489: ##################################################
1.207     www      2490: # Overview mode
                   2491: ##################################################
1.124     www      2492: my $tableopen;
                   2493: 
                   2494: sub tablestart {
                   2495:     if ($tableopen) {
                   2496: 	return '';
                   2497:     } else {
                   2498: 	$tableopen=1;
1.295     albertel 2499: 	return &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th><th>'.
1.130     www      2500: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      2501:     }
                   2502: }
                   2503: 
                   2504: sub tableend {
                   2505:     if ($tableopen) {
                   2506: 	$tableopen=0;
1.295     albertel 2507: 	return &Apache::loncommon::end_data_table();
1.124     www      2508:     } else {
                   2509: 	return'';
                   2510:     }
                   2511: }
                   2512: 
1.207     www      2513: sub readdata {
                   2514:     my ($crs,$dom)=@_;
                   2515: # Read coursedata
                   2516:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2517: # Read userdata
                   2518: 
                   2519:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2520:     foreach (keys %$classlist) {
1.350     albertel 2521:         if ($_=~/^($match_username)\:($match_domain)$/) {
1.207     www      2522: 	    my ($tuname,$tudom)=($1,$2);
                   2523: 	    my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   2524:             foreach my $userkey (keys %{$useropt}) {
                   2525: 		if ($userkey=~/^$env{'request.course.id'}/) {
                   2526:                     my $newkey=$userkey;
                   2527: 		    $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2528: 		    $$resourcedata{$newkey}=$$useropt{$userkey};
                   2529: 		}
                   2530: 	    }
                   2531: 	}
                   2532:     }
                   2533:     return $resourcedata;
                   2534: }
                   2535: 
                   2536: 
1.124     www      2537: # Setting
1.208     www      2538: 
                   2539: sub storedata {
                   2540:     my ($r,$crs,$dom)=@_;
1.207     www      2541: # Set userlevel immediately
                   2542: # Do an intermediate store of course level
                   2543:     my $olddata=&readdata($crs,$dom);
1.124     www      2544:     my %newdata=();
                   2545:     undef %newdata;
                   2546:     my @deldata=();
                   2547:     undef @deldata;
1.190     albertel 2548:     foreach (keys %env) {
1.124     www      2549: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   2550: 	    my $cmd=$1;
                   2551: 	    my $thiskey=$2;
1.207     www      2552: 	    my ($tuname,$tudom)=&extractuser($thiskey);
                   2553: 	    my $tkey=$thiskey;
                   2554:             if ($tuname) {
                   2555: 		$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2556: 	    }
1.385     albertel 2557: 	    if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.384     albertel 2558: 		my ($data, $typeof, $text);
                   2559: 		if ($cmd eq 'set') {
                   2560: 		    $data=$env{$_};
                   2561: 		    $typeof=$env{'form.typeof_'.$thiskey};
                   2562: 		    $text = &mt('Saved modified parameter for');
                   2563: 		} elsif ($cmd eq 'datepointer') {
                   2564: 		    $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
                   2565: 		    $typeof=$env{'form.typeof_'.$thiskey};
                   2566: 		    $text = &mt('Saved modified date for');
1.385     albertel 2567: 		} elsif ($cmd eq 'dateinterval') {
                   2568: 		    $data=&get_date_interval_from_form($thiskey);
                   2569: 		    $typeof=$env{'form.typeof_'.$thiskey};
                   2570: 		    $text = &mt('Saved modified date for');
1.384     albertel 2571: 		}
1.446     bisitz   2572: 		if (defined($data) and $$olddata{$thiskey} ne $data) {
1.207     www      2573: 		    if ($tuname) {
1.212     www      2574: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2575: 								 $tkey.'.type' => $typeof},
                   2576: 						 $tudom,$tuname) eq 'ok') {
1.290     www      2577: 			    &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
1.384     albertel 2578: 			    $r->print('<br />'.$text.' '.
1.207     www      2579: 				      &Apache::loncommon::plainname($tuname,$tudom));
                   2580: 			} else {
1.314     albertel 2581: 			    $r->print('<div class="LC_error">'.
1.365     albertel 2582: 				      &mt('Error saving parameters').'</div>');
1.207     www      2583: 			}
                   2584: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2585: 		    } else {
                   2586: 			$newdata{$thiskey}=$data;
1.446     bisitz   2587:  			$newdata{$thiskey.'.type'}=$typeof;
                   2588:                    }
1.207     www      2589: 		}
1.124     www      2590: 	    } elsif ($cmd eq 'del') {
1.207     www      2591: 		if ($tuname) {
                   2592: 		    if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
1.290     www      2593: 			    &log_parmset({$tkey=>''},1,$tuname,$tudom);
1.207     www      2594: 			$r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2595: 		    } else {
1.314     albertel 2596: 			$r->print('<div class="LC_error">'.
                   2597: 				  &mt('Error deleting parameters').'</div>');
1.207     www      2598: 		    }
                   2599: 		    &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2600: 		} else {
1.333     albertel 2601: 		    push (@deldata,$thiskey,$thiskey.'.type');
1.207     www      2602: 		}
1.124     www      2603: 	    }
                   2604: 	}
                   2605:     }
1.207     www      2606: # Store all course level
1.144     www      2607:     my $delentries=$#deldata+1;
                   2608:     my @newdatakeys=keys %newdata;
                   2609:     my $putentries=$#newdatakeys+1;
                   2610:     if ($delentries) {
                   2611: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
1.290     www      2612: 	    my %loghash=map { $_ => '' } @deldata;
                   2613: 	    &log_parmset(\%loghash,1);
1.144     www      2614: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   2615: 	} else {
1.314     albertel 2616: 	    $r->print('<div class="LC_error">'.
                   2617: 		      &mt('Error deleting parameters').'</div>');
1.144     www      2618: 	}
1.205     www      2619: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2620:     }
                   2621:     if ($putentries) {
                   2622: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1.290     www      2623: 			    &log_parmset(\%newdata,0);
1.365     albertel 2624: 	    $r->print('<h3>'.&mt('Saved [_1] parameter(s)',$putentries/2).'</h3>');
1.144     www      2625: 	} else {
1.314     albertel 2626: 	    $r->print('<div class="LC_error">'.
1.365     albertel 2627: 		      &mt('Error saving parameters').'</div>');
1.144     www      2628: 	}
1.205     www      2629: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2630:     }
1.208     www      2631: }
1.207     www      2632: 
1.208     www      2633: sub extractuser {
                   2634:     my $key=shift;
1.350     albertel 2635:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      2636: }
1.206     www      2637: 
1.381     albertel 2638: sub parse_listdata_key {
                   2639:     my ($key,$listdata) = @_;
                   2640:     # split into student/section affected, and
                   2641:     # the realm (folder/resource part and parameter
1.446     bisitz   2642:     my ($student,$realm) =
1.381     albertel 2643: 	($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
                   2644:     # if course wide student would be undefined
                   2645:     if (!defined($student)) {
                   2646: 	($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
                   2647:     }
                   2648:     # strip off the .type if it's not the Question type parameter
                   2649:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
                   2650: 	$realm=~s/\.type//;
                   2651:     }
                   2652:     # split into resource+part and parameter name
1.388     albertel 2653:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   2654:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 2655:     return ($student,$res,$part,$parm);
                   2656: }
                   2657: 
1.208     www      2658: sub listdata {
1.214     www      2659:     my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207     www      2660: # Start list output
1.206     www      2661: 
1.122     www      2662:     my $oldsection='';
                   2663:     my $oldrealm='';
                   2664:     my $oldpart='';
1.123     www      2665:     my $pointer=0;
1.124     www      2666:     $tableopen=0;
1.145     www      2667:     my $foundkeys=0;
1.248     albertel 2668:     my %keyorder=&standardkeyorder();
1.381     albertel 2669: 
1.214     www      2670:     foreach my $thiskey (sort {
1.381     albertel 2671: 	my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   2672: 	my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
                   2673: 
                   2674: 	# get the numerical order for the param
                   2675: 	$aparm=$keyorder{'parameter_0_'.$aparm};
                   2676: 	$bparm=$keyorder{'parameter_0_'.$bparm};
                   2677: 
                   2678: 	my $result=0;
                   2679: 
1.214     www      2680: 	if ($sortorder eq 'realmstudent') {
1.381     albertel 2681:             if ($ares     ne $bres    ) {
                   2682: 		$result = ($ares     cmp $bres);
1.446     bisitz   2683:             } elsif ($astudent ne $bstudent) {
1.381     albertel 2684: 		$result = ($astudent cmp $bstudent);
                   2685: 	    } elsif ($apart    ne $bpart   ) {
                   2686: 		$result = ($apart    cmp $bpart);
1.237     albertel 2687: 	    }
1.381     albertel 2688: 	} else {
1.446     bisitz   2689: 	    if      ($astudent ne $bstudent) {
1.381     albertel 2690: 		$result = ($astudent cmp $bstudent);
                   2691: 	    } elsif ($ares     ne $bres    ) {
                   2692: 		$result = ($ares     cmp $bres);
                   2693: 	    } elsif ($apart    ne $bpart   ) {
                   2694: 		$result = ($apart    cmp $bpart);
1.247     albertel 2695: 	    }
1.381     albertel 2696: 	}
1.446     bisitz   2697: 
1.381     albertel 2698: 	if (!$result) {
                   2699:             if (defined($aparm) && defined($bparm)) {
                   2700: 		$result = ($aparm <=> $bparm);
                   2701:             } elsif (defined($aparm)) {
                   2702: 		$result = -1;
                   2703:             } elsif (defined($bparm)) {
                   2704: 		$result = 1;
1.248     albertel 2705: 	    }
1.214     www      2706: 	}
1.381     albertel 2707: 
                   2708: 	$result;
1.214     www      2709:     } keys %{$listdata}) {
1.381     albertel 2710: 
1.211     www      2711: 	if ($$listdata{$thiskey.'.type'}) {
                   2712:             my $thistype=$$listdata{$thiskey.'.type'};
                   2713:             if ($$resourcedata{$thiskey.'.type'}) {
                   2714: 		$thistype=$$resourcedata{$thiskey.'.type'};
                   2715: 	    }
1.207     www      2716: 	    my ($middle,$part,$name)=
                   2717: 		($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      2718: 	    my $section=&mt('All Students');
1.207     www      2719: 	    if ($middle=~/^\[(.*)\]/) {
1.206     www      2720: 		my $issection=$1;
1.350     albertel 2721: 		if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
1.206     www      2722: 		    $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   2723: 		} else {
                   2724: 		    $section=&mt('Group/Section').': '.$issection;
                   2725: 		}
1.207     www      2726: 		$middle=~s/^\[(.*)\]//;
1.122     www      2727: 	    }
1.207     www      2728: 	    $middle=~s/\.+$//;
                   2729: 	    $middle=~s/^\.+//;
1.316     albertel 2730: 	    my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.122     www      2731: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.316     albertel 2732: 		$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      2733: 	    } elsif ($middle) {
1.174     albertel 2734: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
1.316     albertel 2735: 		$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      2736: 	    }
1.214     www      2737: 	    if ($sortorder eq 'realmstudent') {
                   2738: 		if ($realm ne $oldrealm) {
                   2739: 		    $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   2740: 		    $oldrealm=$realm;
                   2741: 		    $oldsection='';
                   2742: 		}
                   2743: 		if ($section ne $oldsection) {
                   2744: 		    $r->print(&tableend()."\n<h2>$section</h2>");
                   2745: 		    $oldsection=$section;
                   2746: 		    $oldpart='';
                   2747: 		}
                   2748: 	    } else {
                   2749: 		if ($section ne $oldsection) {
                   2750: 		    $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   2751: 		    $oldsection=$section;
                   2752: 		    $oldrealm='';
                   2753: 		}
                   2754: 		if ($realm ne $oldrealm) {
                   2755: 		    $r->print(&tableend()."\n<h2>$realm</h2>");
                   2756: 		    $oldrealm=$realm;
                   2757: 		    $oldpart='';
                   2758: 		}
1.122     www      2759: 	    }
                   2760: 	    if ($part ne $oldpart) {
1.124     www      2761: 		$r->print(&tableend().
1.422     bisitz   2762: 			  "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
1.122     www      2763: 		$oldpart=$part;
                   2764: 	    }
1.123     www      2765: #
                   2766: # Ready to print
                   2767: #
1.295     albertel 2768: 	    $r->print(&tablestart().
                   2769: 		      &Apache::loncommon::start_data_table_row().
                   2770: 		      '<td><b>'.&standard_parameter_names($name).
1.293     www      2771: 		      '</b></td><td><input type="checkbox" name="del_'.
1.124     www      2772: 		      $thiskey.'" /></td><td>');
1.145     www      2773: 	    $foundkeys++;
1.213     www      2774: 	    if (&isdateparm($thistype)) {
1.123     www      2775: 		my $jskey='key_'.$pointer;
                   2776: 		$pointer++;
                   2777: 		$r->print(
1.232     albertel 2778: 			  &Apache::lonhtmlcommon::date_setter('parmform',
1.123     www      2779: 							      $jskey,
1.219     www      2780: 						      $$resourcedata{$thiskey},
1.325     www      2781: 							      '',1,'','').
1.277     www      2782: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.413     bisitz   2783: (($$resourcedata{$thiskey}!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$$resourcedata{$thiskey}.'">'.
                   2784: &mt('Shift all dates based on this date').'</a></span>':'').
1.277     www      2785: &date_sanity_info($$resourcedata{$thiskey})
1.123     www      2786: 			  );
1.385     albertel 2787: 	    } elsif ($thistype eq 'date_interval') {
                   2788: 		$r->print(&date_interval_selector($thiskey,
                   2789: 						  $$resourcedata{$thiskey}));
1.383     albertel 2790: 	    } elsif ($thistype =~ m/^string/) {
                   2791: 		$r->print(&string_selector($thistype,$thiskey,
                   2792: 					   $$resourcedata{$thiskey}));
1.123     www      2793: 	    } else {
1.383     albertel 2794: 		$r->print(&default_selector($thiskey,$$resourcedata{$thiskey}));
1.123     www      2795: 	    }
1.211     www      2796: 	    $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
1.423     bisitz   2797: 		      $thistype.'" />');
1.295     albertel 2798: 	    $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.122     www      2799: 	}
1.121     www      2800:     }
1.208     www      2801:     return $foundkeys;
                   2802: }
                   2803: 
1.385     albertel 2804: 
                   2805: sub date_interval_selector {
                   2806:     my ($thiskey, $showval) = @_;
                   2807:     my $result;
                   2808:     foreach my $which (['days', 86400, 31],
                   2809: 		       ['hours', 3600, 23],
                   2810: 		       ['minutes', 60, 59],
                   2811: 		       ['seconds',  1, 59]) {
                   2812: 	my ($name, $factor, $max) = @{ $which };
                   2813: 	my $amount = int($showval/$factor);
                   2814: 	$showval  %= $factor;
                   2815: 	my %select = ((map {$_ => $_} (0..$max)),
                   2816: 		      'select_form_order' => [0..$max]);
                   2817: 	$result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   2818: 						   %select);
                   2819: 	$result .= ' '.&mt($name);
                   2820:     }
                   2821:     $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   2822:     return $result;
                   2823: 
                   2824: }
                   2825: 
                   2826: sub get_date_interval_from_form {
                   2827:     my ($key) = @_;
                   2828:     my $seconds = 0;
                   2829:     foreach my $which (['days', 86400],
                   2830: 		       ['hours', 3600],
                   2831: 		       ['minutes', 60],
                   2832: 		       ['seconds',  1]) {
                   2833: 	my ($name, $factor) = @{ $which };
                   2834: 	if (defined($env{'form.'.$name.'_'.$key})) {
                   2835: 	    $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   2836: 	}
                   2837:     }
                   2838:     return $seconds;
                   2839: }
                   2840: 
                   2841: 
1.383     albertel 2842: sub default_selector {
                   2843:     my ($thiskey, $showval) = @_;
1.385     albertel 2844:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'" />';
1.383     albertel 2845: }
                   2846: 
1.446     bisitz   2847: my %strings =
1.383     albertel 2848:     (
                   2849:      'string_yesno'
                   2850:              => [[ 'yes', 'Yes' ],
                   2851: 		 [ 'no', 'No' ]],
                   2852:      'string_problemstatus'
                   2853:              => [[ 'yes', 'Yes' ],
1.394     www      2854: 		 [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
1.383     albertel 2855: 		 [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   2856: 		 [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
                   2857:      );
                   2858: 
                   2859: 
                   2860: sub string_selector {
                   2861:     my ($thistype, $thiskey, $showval) = @_;
1.446     bisitz   2862: 
1.383     albertel 2863:     if (!exists($strings{$thistype})) {
                   2864: 	return &default_selector($thiskey,$showval);
                   2865:     }
                   2866: 
                   2867:     my $result;
                   2868:     foreach my $possibilities (@{ $strings{$thistype} }) {
                   2869: 	my ($name, $description) = @{ $possibilities };
                   2870: 	$result .= '<label><input type="radio" name="set_'.$thiskey.
                   2871: 		  '" value="'.$name.'"';
                   2872: 	if ($showval eq $name) {
                   2873: 	    $result .= ' checked="checked"';
                   2874: 	}
                   2875: 	$result .= ' />'.&mt($description).'</label> ';
                   2876:     }
                   2877:     return $result;
                   2878: }
                   2879: 
1.389     www      2880: #
                   2881: # Shift all start and end dates by $shift
                   2882: #
                   2883: 
                   2884: sub dateshift {
                   2885:     my ($shift)=@_;
                   2886:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2887:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2888:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   2889: # ugly retro fix for broken version of types
                   2890:     foreach my $key (keys %data) {
                   2891:         if ($key=~/\wtype$/) {
                   2892:             my $newkey=$key;
                   2893:             $newkey=~s/type$/\.type/;
                   2894:             $data{$newkey}=$data{$key};
                   2895:             delete $data{$key};
                   2896:         }
                   2897:     }
1.391     www      2898:     my %storecontent=();
1.389     www      2899: # go through all parameters and look for dates
                   2900:     foreach my $key (keys %data) {
                   2901:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   2902:           my $newdate=$data{$key}+$shift;
1.391     www      2903:           $storecontent{$key}=$newdate;
1.389     www      2904:        }
                   2905:     }
1.391     www      2906:     my $reply=&Apache::lonnet::cput
                   2907:                 ('resourcedata',\%storecontent,$dom,$crs);
                   2908:     if ($reply eq 'ok') {
                   2909:        &log_parmset(\%storecontent);
                   2910:     }
                   2911:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   2912:     return $reply;
1.389     www      2913: }
                   2914: 
1.208     www      2915: sub newoverview {
1.280     albertel 2916:     my ($r) = @_;
                   2917: 
1.208     www      2918:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2919:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 2920:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   2921:     	text=>"Overview Mode"});
1.280     albertel 2922:     my $start_page = &Apache::loncommon::start_page('Set Parameters');
1.298     albertel 2923:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      2924:     $r->print(<<ENDOVER);
1.280     albertel 2925: $start_page
1.208     www      2926: $breadcrumbs
1.232     albertel 2927: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      2928: ENDOVER
1.211     www      2929:     my @ids=();
                   2930:     my %typep=();
                   2931:     my %keyp=();
                   2932:     my %allparms=();
                   2933:     my %allparts=();
                   2934:     my %allmaps=();
                   2935:     my %mapp=();
                   2936:     my %symbp=();
                   2937:     my %maptitles=();
                   2938:     my %uris=();
                   2939:     my %keyorder=&standardkeyorder();
                   2940:     my %defkeytype=();
                   2941: 
                   2942:     my %alllevs=();
                   2943:     $alllevs{'Resource Level'}='full';
1.215     www      2944:     $alllevs{'Map/Folder Level'}='map';
1.211     www      2945:     $alllevs{'Course Level'}='general';
                   2946: 
                   2947:     my $csec=$env{'form.csec'};
1.269     raeburn  2948:     my $cgroup=$env{'form.cgroup'};
1.211     www      2949: 
                   2950:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   2951:     my $pschp=$env{'form.pschp'};
                   2952:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
                   2953:     if (!@psprt) { $psprt[0]='0'; }
                   2954: 
1.446     bisitz   2955:     my @selected_sections =
1.211     www      2956: 	&Apache::loncommon::get_env_multiple('form.Section');
                   2957:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 2958:     foreach my $sec (@selected_sections) {
                   2959:         if ($sec eq 'all') {
1.211     www      2960:             @selected_sections = ('all');
                   2961:         }
                   2962:     }
1.269     raeburn  2963:     my @selected_groups =
                   2964:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      2965: 
                   2966:     my $pssymb='';
                   2967:     my $parmlev='';
1.446     bisitz   2968: 
1.211     www      2969:     unless ($env{'form.parmlev'}) {
                   2970:         $parmlev = 'map';
                   2971:     } else {
                   2972:         $parmlev = $env{'form.parmlev'};
                   2973:     }
                   2974: 
1.446     bisitz   2975:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.211     www      2976: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   2977: 				\%keyorder,\%defkeytype);
                   2978: 
1.374     albertel 2979:     if (grep {$_ eq 'all'} (@psprt)) {
                   2980: 	@psprt = keys(%allparts);
                   2981:     }
1.211     www      2982: # Menu to select levels, etc
                   2983: 
1.445     neumanie 2984:     #$r->print('<table id="LC_parm_overview_scope">
                   2985:     #           <tr><td class="LC_parm_overview_level_menu">');
1.456     bisitz   2986:     $r->print('<div class="LC_Box">');
1.445     neumanie 2987:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   2988:     $r->print('<div>');
1.445     neumanie 2989:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.211     www      2990:     &levelmenu($r,\%alllevs,$parmlev);
                   2991:     if ($parmlev ne 'general') {
1.445     neumanie 2992: 	#$r->print('<td class="LC_parm_overview_map_menu">');
1.447     bisitz   2993:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.211     www      2994: 	&mapmenu($r,\%allmaps,$pschp,\%maptitles);
1.445     neumanie 2995: 	#$r->print('</td>');
1.211     www      2996:     }
1.447     bisitz   2997:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 2998:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   2999:     $r->print('</div></div>');
                   3000:     #$r->print('</td></tr></table>');
1.446     bisitz   3001: 
1.445     neumanie 3002:     #$r->print('<table id="LC_parm_overview_controls">
                   3003:     #           <tr><td class="LC_parm_overview_parm_selectors">');
1.456     bisitz   3004:     $r->print('<div class="LC_Box">');
1.452     bisitz   3005:     $r->print('<div>');
1.446     bisitz   3006:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.445     neumanie 3007:     &parmmenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 3008:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3009:     &parmboxes($r,\%allparms,\@pscat,\%keyorder);
                   3010:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   3011:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.445     neumanie 3012:     #$r->print('</td><td class="LC_parm_overview_restrictions">'.
                   3013:      $r->print('<table>'.
1.317     albertel 3014:               '<tr><th>'.&mt('Parts').'</th><th>'.&mt('Section(s)').
                   3015:               '</th><th>'.&mt('Group(s)').'</th></tr><tr><td>');
1.211     www      3016:     &partmenu($r,\%allparts,\@psprt);
1.317     albertel 3017:     $r->print('</td><td>');
1.211     www      3018:     &sectionmenu($r,\@selected_sections);
1.317     albertel 3019:     $r->print('</td><td>');
1.269     raeburn  3020:     &groupmenu($r,\@selected_groups);
                   3021:     $r->print('</td></tr></table>');
1.445     neumanie 3022:     #$r->print('</td></tr></table>');
1.447     bisitz   3023:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 3024:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3025:     $r->print('</div></div>');
                   3026: 
1.456     bisitz   3027:     $r->print('<div class="LC_Box">');
1.452     bisitz   3028:     $r->print('<div>');
1.214     www      3029:     my $sortorder=$env{'form.sortorder'};
                   3030:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3031:     &sortmenu($r,$sortorder);
1.445     neumanie 3032:     $r->print('</div></div>');
1.446     bisitz   3033: 
1.214     www      3034:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   3035: 
1.211     www      3036: # Build the list data hash from the specified parms
                   3037: 
                   3038:     my $listdata;
                   3039:     %{$listdata}=();
                   3040: 
                   3041:     foreach my $cat (@pscat) {
1.269     raeburn  3042:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   3043:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      3044:     }
                   3045: 
1.212     www      3046:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      3047: 
1.212     www      3048: 	if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      3049: 
                   3050: # Read modified data
                   3051: 
                   3052: 	my $resourcedata=&readdata($crs,$dom);
                   3053: 
                   3054: # List data
                   3055: 
1.214     www      3056: 	&listdata($r,$resourcedata,$listdata,$sortorder);
1.211     www      3057:     }
                   3058:     $r->print(&tableend().
1.365     albertel 3059: 	     ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'').
1.280     albertel 3060: 	      '</form>'.&Apache::loncommon::end_page());
1.208     www      3061: }
                   3062: 
1.269     raeburn  3063: sub secgroup_lister {
                   3064:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   3065:     foreach my $item (@{$selections}) {
                   3066:         foreach my $part (@{$psprt}) {
                   3067:             my $rootparmkey=$env{'request.course.id'};
                   3068:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   3069:                 $rootparmkey.='.['.$item.']';
                   3070:             }
                   3071:             if ($parmlev eq 'general') {
                   3072: # course-level parameter
                   3073:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   3074:                 $$listdata{$newparmkey}=1;
                   3075:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3076:             } elsif ($parmlev eq 'map') {
                   3077: # map-level parameter
                   3078:                 foreach my $mapid (keys %{$allmaps}) {
                   3079:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   3080:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   3081:                     $$listdata{$newparmkey}=1;
                   3082:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3083:                 }
                   3084:             } else {
                   3085: # resource-level parameter
                   3086:                 foreach my $rid (@{$ids}) {
                   3087:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   3088:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   3089:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   3090:                     $$listdata{$newparmkey}=1;
                   3091:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   3092:                 }
                   3093:             }
                   3094:         }
                   3095:     }
                   3096: }
                   3097: 
1.208     www      3098: sub overview {
1.280     albertel 3099:     my ($r) = @_;
1.208     www      3100:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3101:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 3102: 
1.414     droeschl 3103:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3104: 	text=>"Overview Mode"});
1.280     albertel 3105:     my $start_page=&Apache::loncommon::start_page('Modify Parameters');
1.298     albertel 3106:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      3107:     $r->print(<<ENDOVER);
1.280     albertel 3108: $start_page
1.208     www      3109: $breadcrumbs
1.232     albertel 3110: <form method="post" action="/adm/parmset?action=setoverview" name="parmform">
1.208     www      3111: ENDOVER
                   3112: # Store modified
                   3113: 
                   3114:     &storedata($r,$crs,$dom);
                   3115: 
                   3116: # Read modified data
                   3117: 
                   3118:     my $resourcedata=&readdata($crs,$dom);
                   3119: 
1.214     www      3120: 
                   3121:     my $sortorder=$env{'form.sortorder'};
                   3122:     unless ($sortorder) { $sortorder='realmstudent'; }
                   3123:     &sortmenu($r,$sortorder);
                   3124: 
1.208     www      3125: # List data
                   3126: 
1.214     www      3127:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208     www      3128: 
1.145     www      3129:     $r->print(&tableend().'<p>'.
1.430     schafran 3130: 	($foundkeys?'<input type="submit" value="'.&mt('Save').'" />':&mt('There are no parameters.')).'</p></form>'.
1.280     albertel 3131: 	      &Apache::loncommon::end_page());
1.120     www      3132: }
1.121     www      3133: 
1.333     albertel 3134: sub clean_parameters {
                   3135:     my ($r) = @_;
                   3136:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3137:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3138: 
1.414     droeschl 3139:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
                   3140:     	text=>"Clean Parameters"});
1.333     albertel 3141:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   3142:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   3143:     $r->print(<<ENDOVER);
                   3144: $start_page
                   3145: $breadcrumbs
                   3146: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   3147: ENDOVER
                   3148: # Store modified
                   3149: 
                   3150:     &storedata($r,$crs,$dom);
                   3151: 
                   3152: # Read modified data
                   3153: 
                   3154:     my $resourcedata=&readdata($crs,$dom);
                   3155: 
                   3156: # List data
                   3157: 
                   3158:     $r->print('<h3>'.
                   3159: 	      &mt('These parameters refer to resources that do not exist.').
                   3160: 	      '</h3>'.
1.415     schafran 3161: 	      '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
1.333     albertel 3162: 	      '<br />');
                   3163:     $r->print(&Apache::loncommon::start_data_table().
                   3164: 	      '<tr>'.
                   3165: 	      '<th>'.&mt('Delete').'</th>'.
                   3166: 	      '<th>'.&mt('Parameter').'</th>'.
                   3167: 	      '</tr>');
                   3168:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
                   3169: 	next if (!exists($resourcedata->{$thiskey.'.type'})
                   3170: 		 && $thiskey=~/\.type$/);
                   3171: 	my %data = &parse_key($thiskey);
1.383     albertel 3172: 	if (1) { #exists($data{'realm_exists'})
                   3173: 	    #&& !$data{'realm_exists'}) {
1.333     albertel 3174: 	    $r->print(&Apache::loncommon::start_data_table_row().
                   3175: 		      '<tr>'.
                   3176: 		      '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'		      );
1.446     bisitz   3177: 
1.333     albertel 3178: 	    $r->print('<td>');
1.362     albertel 3179: 	    my $display_value = $resourcedata->{$thiskey};
                   3180: 	    if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
1.446     bisitz   3181: 		$display_value =
1.362     albertel 3182: 		    &Apache::lonlocal::locallocaltime($display_value);
                   3183: 	    }
1.333     albertel 3184: 	    $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   3185: 			  &standard_parameter_names($data{'parameter_name'}),
                   3186: 			  $resourcedata->{$thiskey}));
                   3187: 	    $r->print('<br />');
                   3188: 	    if ($data{'scope_type'} eq 'all') {
                   3189: 		$r->print(&mt('All users'));
                   3190: 	    } elsif ($data{'scope_type'} eq 'user') {
                   3191: 		$r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
                   3192: 	    } elsif ($data{'scope_type'} eq 'section') {
                   3193: 		$r->print(&mt('Section: [_1]',$data{'scope'}));
                   3194: 	    } elsif ($data{'scope_type'} eq 'group') {
                   3195: 		$r->print(&mt('Group: [_1]',$data{'scope'}));
                   3196: 	    }
                   3197: 	    $r->print('<br />');
                   3198: 	    if ($data{'realm_type'} eq 'all') {
                   3199: 		$r->print(&mt('All Resources'));
                   3200: 	    } elsif ($data{'realm_type'} eq 'folder') {
                   3201: 		$r->print(&mt('Folder: [_1]'),$data{'realm'});
                   3202: 	    } elsif ($data{'realm_type'} eq 'symb') {
                   3203: 		my ($map,$resid,$url) =
                   3204: 		    &Apache::lonnet::decode_symb($data{'realm'});
                   3205: 		$r->print(&mt('Resource: [_1] <br />&nbsp;&nbsp;&nbsp;with ID: [_2] <br />&nbsp;&nbsp;&nbsp;in folder [_3]',
                   3206: 			      $url,$resid,$map));
                   3207: 	    }
1.362     albertel 3208: 	    $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
1.333     albertel 3209: 	    $r->print('</td></tr>');
1.446     bisitz   3210: 
1.333     albertel 3211: 	}
                   3212:     }
                   3213:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.415     schafran 3214: 	      '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.333     albertel 3215: 	      '</p></form>'.
                   3216: 	      &Apache::loncommon::end_page());
                   3217: }
                   3218: 
1.390     www      3219: sub date_shift_one {
                   3220:     my ($r) = @_;
                   3221:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3222:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3223: 
1.414     droeschl 3224:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
                   3225:     	text=>"Shifting Dates"});
1.390     www      3226:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3227:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
                   3228:     $r->print(<<ENDOVER);
                   3229: $start_page
                   3230: $breadcrumbs
                   3231: ENDOVER
                   3232:     $r->print('<form name="shiftform" method="post">'.
                   3233:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   3234:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   3235:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
                   3236:                     &Apache::lonhtmlcommon::date_setter('shiftform',
                   3237:                                                         'timeshifted',
                   3238:                                                         $env{'form.timebase'},,
                   3239:                                                         '').
                   3240:               '</td></tr></table>'.
                   3241:               '<input type="hidden" name="action" value="dateshift2" />'.
                   3242:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   3243:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
                   3244:     $r->print(&Apache::loncommon::end_page());
                   3245: }
                   3246: 
                   3247: sub date_shift_two {
                   3248:     my ($r) = @_;
                   3249:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3250:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.414     droeschl 3251:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
                   3252:     	text=>"Shifting Dates"});
1.390     www      3253:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   3254:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
                   3255:     $r->print(<<ENDOVER);
                   3256: $start_page
                   3257: $breadcrumbs
                   3258: ENDOVER
                   3259:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
                   3260:     $r->print(&mt('Shifting all dates such that [_1] becomes [_2]',
                   3261:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
                   3262:               &Apache::lonlocal::locallocaltime($timeshifted)));
                   3263:     my $delta=$timeshifted-$env{'form.timebase'};
                   3264:     &dateshift($delta);
                   3265:     $r->print(&Apache::loncommon::end_page());
                   3266: }
                   3267: 
1.333     albertel 3268: sub parse_key {
                   3269:     my ($key) = @_;
                   3270:     my %data;
                   3271:     my ($middle,$part,$name)=
                   3272: 	($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3273:     $data{'scope_type'} = 'all';
                   3274:     if ($middle=~/^\[(.*)\]/) {
                   3275:        	$data{'scope'} = $1;
1.350     albertel 3276: 	if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
1.333     albertel 3277: 	    $data{'scope_type'} = 'user';
                   3278: 	    $data{'scope'} = [$1,$2];
                   3279: 	} else {
                   3280: 	    #FIXME check for group scope
                   3281: 	    $data{'scope_type'} = 'section';
                   3282: 	}
                   3283: 	$middle=~s/^\[(.*)\]//;
                   3284:     }
                   3285:     $middle=~s/\.+$//;
                   3286:     $middle=~s/^\.+//;
                   3287:     $data{'realm_type'}='all';
                   3288:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   3289: 	$data{'realm'} = $1;
                   3290: 	$data{'realm_type'} = 'folder';
                   3291: 	$data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3292: 	($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
                   3293:     } elsif ($middle) {
                   3294: 	$data{'realm'} = $middle;
                   3295: 	$data{'realm_type'} = 'symb';
                   3296: 	$data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   3297: 	my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   3298: 	$data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
                   3299:     }
1.446     bisitz   3300: 
1.333     albertel 3301:     $data{'parameter_part'} = $part;
                   3302:     $data{'parameter_name'} = $name;
                   3303: 
                   3304:     return %data;
                   3305: }
                   3306: 
1.239     raeburn  3307: 
1.178     raeburn  3308: 
1.239     raeburn  3309: sub extract_cloners {
                   3310:     my ($clonelist,$allowclone) = @_;
                   3311:     if ($clonelist =~ /,/) {
1.380     albertel 3312:         @{$allowclone} = split(/,/,$clonelist);
1.239     raeburn  3313:     } else {
                   3314:         $$allowclone[0] = $clonelist;
                   3315:     }
                   3316: }
                   3317: 
                   3318: sub check_cloners {
                   3319:     my ($clonelist,$oldcloner) = @_;
1.379     raeburn  3320:     my ($clean_clonelist,%disallowed);
1.239     raeburn  3321:     my @allowclone = ();
                   3322:     &extract_cloners($$clonelist,\@allowclone);
                   3323:     foreach my $currclone (@allowclone) {
1.380     albertel 3324:         if (!grep(/^\Q$currclone\E$/,@$oldcloner)) {
1.379     raeburn  3325:             if ($currclone eq '*') {
                   3326:                 $clean_clonelist .= $currclone.',';
                   3327:             } else {
                   3328:                 my ($uname,$udom) = split(/:/,$currclone);
                   3329:                 if ($uname eq '*') {
                   3330:                     if ($udom =~ /^$match_domain$/) {
1.380     albertel 3331:                         if (!&Apache::lonnet::domain($udom)) {
1.379     raeburn  3332:                             $disallowed{'domain'} .= $currclone.',';
                   3333:                         } else {
                   3334:                             $clean_clonelist .= $currclone.',';
                   3335:                         }
                   3336:                     } else {
                   3337:                         $disallowed{'format'} .= $currclone.',';
                   3338:                     }
                   3339:                 } elsif ($currclone !~/^($match_username)\:($match_domain)$/) {
1.446     bisitz   3340:                     $disallowed{'format'} .= $currclone.',';
1.239     raeburn  3341:                 } else {
1.379     raeburn  3342:                     if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   3343:                         $disallowed{'newuser'} .= $currclone.',';
                   3344:                     } else {
                   3345:                         $clean_clonelist .= $currclone.',';
                   3346:                     }
1.239     raeburn  3347:                 }
                   3348:             }
                   3349:         } else {
                   3350:             $clean_clonelist .= $currclone.',';
                   3351:         }
                   3352:     }
1.379     raeburn  3353:     foreach my $key (keys(%disallowed)) {
                   3354:         $disallowed{$key} =~ s/,$//;
1.239     raeburn  3355:     }
                   3356:     if ($clean_clonelist) {
                   3357:         $clean_clonelist =~ s/,$//;
                   3358:     }
                   3359:     $$clonelist = $clean_clonelist;
1.379     raeburn  3360:     return %disallowed;
                   3361: }
1.178     raeburn  3362: 
                   3363: sub change_clone {
                   3364:     my ($clonelist,$oldcloner) = @_;
                   3365:     my ($uname,$udom);
1.190     albertel 3366:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3367:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178     raeburn  3368:     my $clone_crs = $cnum.':'.$cdom;
1.446     bisitz   3369: 
1.178     raeburn  3370:     if ($cnum && $cdom) {
1.239     raeburn  3371:         my @allowclone;
                   3372:         &extract_cloners($clonelist,\@allowclone);
1.178     raeburn  3373:         foreach my $currclone (@allowclone) {
1.380     albertel 3374:             if (!grep(/^$currclone$/,@$oldcloner)) {
1.379     raeburn  3375:                 if ($currclone ne '*') {
1.380     albertel 3376:                     ($uname,$udom) = split(/:/,$currclone);
1.379     raeburn  3377:                     if ($uname && $udom && $uname ne '*') {
                   3378:                         if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
                   3379:                             my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   3380:                             if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   3381:                                 if ($currclonecrs{'cloneable'} eq '') {
                   3382:                                     $currclonecrs{'cloneable'} = $clone_crs;
                   3383:                                 } else {
                   3384:                                     $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   3385:                                 }
                   3386:                                 &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
1.178     raeburn  3387:                             }
                   3388:                         }
                   3389:                     }
                   3390:                 }
                   3391:             }
                   3392:         }
                   3393:         foreach my $oldclone (@$oldcloner) {
1.380     albertel 3394:             if (!grep(/^\Q$oldclone\E$/,@allowclone)) {
1.379     raeburn  3395:                 if ($oldclone ne '*') {
1.380     albertel 3396:                     ($uname,$udom) = split(/:/,$oldclone);
1.379     raeburn  3397:                     if ($uname && $udom && $uname ne '*' ) {
                   3398:                         if (&Apache::lonnet::homeserver($uname,$udom) ne 'no_host') {
                   3399:                             my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   3400:                             my %newclonecrs = ();
                   3401:                             if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   3402:                                 if ($currclonecrs{'cloneable'} =~ /,/) {
                   3403:                                     my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   3404:                                     foreach my $crs (@currclonecrs) {
                   3405:                                         if ($crs ne $clone_crs) {
                   3406:                                             $newclonecrs{'cloneable'} .= $crs.',';
                   3407:                                         }
1.178     raeburn  3408:                                     }
1.379     raeburn  3409:                                     $newclonecrs{'cloneable'} =~ s/,$//;
                   3410:                                 } else {
                   3411:                                     $newclonecrs{'cloneable'} = '';
1.178     raeburn  3412:                                 }
1.379     raeburn  3413:                                 &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
1.178     raeburn  3414:                             }
                   3415:                         }
                   3416:                     }
                   3417:                 }
                   3418:             }
                   3419:         }
                   3420:     }
                   3421: }
                   3422: 
1.193     albertel 3423: 
                   3424: 
1.416     jms      3425: sub header {
                   3426:     return &Apache::loncommon::start_page('Parameter Manager');
                   3427: }
1.193     albertel 3428: 
                   3429: 
                   3430: 
                   3431: sub print_main_menu {
                   3432:     my ($r,$parm_permission)=@_;
                   3433:     #
1.414     droeschl 3434:     $r->print(&header());
                   3435:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Manager'));
1.193     albertel 3436:     $r->print(<<ENDMAINFORMHEAD);
                   3437: <form method="post" enctype="multipart/form-data"
                   3438:       action="/adm/parmset" name="studentform">
                   3439: ENDMAINFORMHEAD
                   3440: #
1.195     albertel 3441:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3442:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 3443:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 3444:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.268     albertel 3445: 
1.417     droeschl 3446: 
1.193     albertel 3447:     my @menu =
1.417     droeschl 3448:         ( { categorytitle=>'Settings for this Course',
1.414     droeschl 3449: 	    items => [
1.450     raeburn  3450: 		  { linktext => 'Course Configuration',
                   3451: 		    url => '/adm/courseprefs?origin=params',
1.414     droeschl 3452: 		    permission => $parm_permission,
1.450     raeburn  3453: 		    linktitle =>'Edit course configuration.'  ,
1.417     droeschl 3454: 		    icon => 'preferences-desktop-remote-desktop.png'  ,
                   3455: 		    #help => 'Course_Environment',
1.414     droeschl 3456: 		    },
1.417     droeschl 3457: 		  { linktext => 'Portfolio Metadata',
1.414     droeschl 3458: 		    url => '/adm/parmset?action=setrestrictmeta',
                   3459: 		    permission => $parm_permission,
1.417     droeschl 3460: 		    linktitle => 'Restrict metadata for this course.' ,
                   3461: 		    icon =>'contact-new.png'   ,
1.414     droeschl 3462: 		    },
                   3463: 		  { linktext => 'Manage Course Slots',
                   3464: 		    url => '/adm/slotrequest?command=showslots',
                   3465: 		    permission => $vgr,
1.417     droeschl 3466: 		    linktitle =>'Manage slots for this course.'  ,
                   3467: 		    icon => 'format-justify-fill.png'  ,
1.414     droeschl 3468: 		    },
                   3469: 		  { linktext => 'Reset Student Access Times',
                   3470: 		    url => '/adm/helper/resettimes.helper',
                   3471: 		    permission => $mgr,
1.417     droeschl 3472: 		    linktitle =>'Reset access times for folders/maps, resources or the course.'  ,
                   3473: 		    icon => 'start-here.png'  ,
1.414     droeschl 3474: 		    },
                   3475: 
                   3476: 		  { linktext => 'Set Parameter Setting Default Actions',
                   3477: 		    url => '/adm/parmset?action=setdefaults',
                   3478: 		    permission => $parm_permission,
1.417     droeschl 3479: 		    linktitle =>'Set default actions for parameters.'  ,
                   3480: 		    icon => 'folder-new.png'  ,
1.446     bisitz   3481: 		    }]},
1.417     droeschl 3482: 	  { categorytitle => 'New and Existing Parameter Settings for Resources',
1.414     droeschl 3483: 	    items => [
1.417     droeschl 3484: 		  { linktext => 'Edit Resource Parameters - Helper Mode',
1.414     droeschl 3485: 		    url => '/adm/helper/parameter.helper',
                   3486: 		    permission => $parm_permission,
1.417     droeschl 3487: 		    linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   3488: 		    icon => 'dialog-information.png'  ,
                   3489: 		    #help => 'Parameter_Helper',
1.414     droeschl 3490: 		    },
1.417     droeschl 3491: 		  { linktext => 'Edit Resource Parameters - Overview Mode',
1.414     droeschl 3492: 		    url => '/adm/parmset?action=newoverview',
                   3493: 		    permission => $parm_permission,
1.417     droeschl 3494: 		    linktitle =>'Set/Modify resource parameters in overview mode.'  ,
                   3495: 		    icon => 'edit-find.png'  ,
                   3496: 		    #help => 'Parameter_Overview',
1.414     droeschl 3497: 		    },
1.417     droeschl 3498: 		  { linktext => 'Edit Resource Parameters - Table Mode',
1.414     droeschl 3499: 		    url => '/adm/parmset?action=settable',
                   3500: 		    permission => $parm_permission,
1.417     droeschl 3501: 		    linktitle =>'Set/Modify resource parameters in table mode.'  ,
                   3502: 		    icon => 'edit-copy.png'  ,
                   3503: 		    #help => 'Table_Mode',
1.414     droeschl 3504: 		    }]},
1.417     droeschl 3505:            { categorytitle => 'Existing Parameter Settings for Resources',
1.414     droeschl 3506: 	     items => [
                   3507: 		  { linktext => 'Modify Resource Parameters - Overview Mode',
                   3508: 		    url => '/adm/parmset?action=setoverview',
                   3509: 		    permission => $parm_permission,
1.417     droeschl 3510: 		    linktitle =>'Set/Modify existing resource parameters in overview mode.'  ,
                   3511: 		    icon => 'preferences-desktop-wallpaper.png'  ,
                   3512: 		    #help => 'Parameter_Overview',
1.446     bisitz   3513: 		    },
1.417     droeschl 3514: 		  { linktext => 'Change Log',
1.414     droeschl 3515: 		    url => '/adm/parmset?action=parameterchangelog',
                   3516: 		    permission => $parm_permission,
1.417     droeschl 3517: 		    linktitle =>'View parameter and course blog posting/user notification change log.'  ,
                   3518: 		    icon => 'emblem-system.png'   ,
1.414     droeschl 3519: 		    }]}
1.193     albertel 3520:           );
1.414     droeschl 3521:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.193     albertel 3522:     return;
                   3523: }
1.414     droeschl 3524: 
1.416     jms      3525: 
                   3526: 
1.252     banghart 3527: sub output_row {
1.347     banghart 3528:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 3529:     my $output;
1.263     banghart 3530:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   3531:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 3532:     if (!defined($options)) {
1.254     banghart 3533:         $options = 'active,stuadd';
1.261     banghart 3534:         $values = '';
1.252     banghart 3535:     }
1.337     banghart 3536:     if (!($options =~ /deleted/)) {
                   3537:         my @options= ( ['active', 'Show to student'],
1.418     schafran 3538:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 3539:                     ['choices','Provide choices for students to select from']);
                   3540: #		   ['onlyone','Student may select only one choice']);
1.337     banghart 3541:         if ($added_flag) {
                   3542:             push @options,['deleted', 'Delete Metadata Field'];
                   3543:         }
1.351     banghart 3544:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   3545:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 3546:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 3547:         foreach my $opt (@options) {
                   3548: 	    my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
1.347     banghart 3549: 	    $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   3550: 	    $output .= '<td>'.('&nbsp;' x 5).'<label>
1.351     banghart 3551: 	               <input type="checkbox" name="'.
                   3552: 	               $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
1.451     bisitz   3553: 	               &mt($opt->[1]).'</label></td>';
1.347     banghart 3554: 	    $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 3555: 	}
1.351     banghart 3556:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   3557:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 3558:         $output .= &Apache::loncommon::end_data_table_row();
                   3559:         my $multiple_checked;
                   3560:         my $single_checked;
                   3561:         if ($options =~ m/onlyone/) {
1.422     bisitz   3562:             $multiple_checked = '';
1.423     bisitz   3563:             $single_checked = ' checked="checked"';
1.351     banghart 3564:         } else {
1.423     bisitz   3565:             $multiple_checked = ' checked="checked"';
1.422     bisitz   3566:             $single_checked = '';
1.351     banghart 3567:         }
                   3568: 	$output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   3569: 	$output .= '<td>'.('&nbsp;' x 10).'
1.423     bisitz   3570: 	            <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
1.451     bisitz   3571: 	            '.&mt('Student may select multiple choices from list').'</td>';
1.351     banghart 3572: 	$output .= &Apache::loncommon::end_data_table_row();
                   3573: 	$output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   3574: 	$output .= '<td>'.('&nbsp;' x 10).'
1.423     bisitz   3575: 	            <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
1.451     bisitz   3576: 	            '.&mt('Student may select only one choice from list').'</td>';
1.351     banghart 3577: 	$output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 3578:     }
                   3579:     return ($output);
                   3580: }
1.416     jms      3581: 
                   3582: 
                   3583: 
1.340     banghart 3584: sub order_meta_fields {
                   3585:     my ($r)=@_;
                   3586:     my $idx = 1;
                   3587:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3588:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.341     banghart 3589:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.414     droeschl 3590:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
                   3591:     	text=>"Add Metadata Field"});
1.345     banghart 3592:     &Apache::lonhtmlcommon::add_breadcrumb
                   3593:             ({href=>"/adm/parmset?action=setrestrictmeta",
                   3594:               text=>"Restrict Metadata"},
                   3595:              {text=>"Order Metadata"});
                   3596:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.340     banghart 3597:     if ($env{'form.storeorder'}) {
                   3598:         my $newpos = $env{'form.newpos'} - 1;
                   3599:         my $currentpos = $env{'form.currentpos'} - 1;
                   3600:         my @neworder = ();
                   3601:         my @oldorder = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3602:         my $i;
1.341     banghart 3603:         if ($newpos > $currentpos) {
1.340     banghart 3604:         # moving stuff up
                   3605:             for ($i=0;$i<$currentpos;$i++) {
                   3606:         	$neworder[$i]=$oldorder[$i];
                   3607:             }
                   3608:             for ($i=$currentpos;$i<$newpos;$i++) {
                   3609:         	$neworder[$i]=$oldorder[$i+1];
                   3610:             }
                   3611:             $neworder[$newpos]=$oldorder[$currentpos];
                   3612:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
                   3613:         	$neworder[$i]=$oldorder[$i];
                   3614:             }
                   3615:         } else {
                   3616:         # moving stuff down
                   3617:     	    for ($i=0;$i<$newpos;$i++) {
                   3618:     	        $neworder[$i]=$oldorder[$i];
                   3619:     	    }
                   3620:     	    $neworder[$newpos]=$oldorder[$currentpos];
                   3621:     	    for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   3622:     	        $neworder[$i]=$oldorder[$i-1];
                   3623:     	    }
                   3624:     	    for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   3625:     	        $neworder[$i]=$oldorder[$i];
                   3626:     	    }
                   3627:         }
                   3628: 	my $ordered_fields = join ",", @neworder;
1.343     banghart 3629:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   3630:                            {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
1.393     raeburn  3631: 	&Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 3632:     }
1.357     raeburn  3633:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 3634:     my $ordered_fields;
1.340     banghart 3635:     my @fields_in_order = split /,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'};
                   3636:     if (!@fields_in_order) {
                   3637:         # no order found, pick sorted order then create metadata.addedorder key.
                   3638:         foreach my $key (sort keys %$fields) {
                   3639:             push @fields_in_order, $key;
1.341     banghart 3640:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 3641:         }
1.341     banghart 3642:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   3643:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   3644:     }
1.340     banghart 3645:     $r->print('<table>');
                   3646:     my $num_fields = scalar(@fields_in_order);
                   3647:     foreach my $key (@fields_in_order) {
                   3648:         $r->print('<tr><td>');
                   3649:         $r->print('<form method="post" action="">');
                   3650:         $r->print('<select name="newpos" onChange="this.form.submit()">');
                   3651:         for (my $i = 1;$i le $num_fields;$i ++) {
                   3652:             if ($i eq $idx) {
                   3653:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   3654:             } else {
                   3655:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   3656:             }
                   3657:         }
                   3658:         $r->print('</select></td><td>');
                   3659:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   3660:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   3661:         $r->print('</form>');
                   3662:         $r->print($$fields{$key}.'</td></tr>');
                   3663:         $idx ++;
                   3664:     }
                   3665:     $r->print('</table>');
                   3666:     return 'ok';
                   3667: }
1.416     jms      3668: 
                   3669: 
1.359     banghart 3670: sub continue {
                   3671:     my $output;
                   3672:     $output .= '<form action="" method="post">';
                   3673:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   3674:     $output .= '<input type="submit" value="Continue" />';
                   3675:     return ($output);
                   3676: }
1.416     jms      3677: 
                   3678: 
1.334     banghart 3679: sub addmetafield {
                   3680:     my ($r)=@_;
1.414     droeschl 3681:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
                   3682:     	text=>"Add Metadata Field"});
1.334     banghart 3683:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   3684:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 3685:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3686:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.339     banghart 3687:     if (exists($env{'form.undelete'})) {
1.358     banghart 3688:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 3689:         foreach my $meta_field(@meta_fields) {
                   3690:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   3691:             $options =~ s/deleted//;
                   3692:             $options =~ s/,,/,/;
                   3693:             my $put_result = &Apache::lonnet::put('environment',
                   3694:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   3695: 
1.339     banghart 3696:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   3697:         }
1.359     banghart 3698:         $r->print(&continue());
1.339     banghart 3699:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 3700:         my $meta_field = $env{'form.fieldname'};
                   3701:         my $display_field = $env{'form.fieldname'};
                   3702:         $meta_field =~ s/\W/_/g;
1.338     banghart 3703:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 3704:         my $put_result = &Apache::lonnet::put('environment',
                   3705:                             {'metadata.'.$meta_field.'.values'=>"",
                   3706:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   3707:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 3708:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   3709:         $r->print(&continue());
1.335     banghart 3710:     } else {
1.357     raeburn  3711:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 3712:         if ($fields) {
                   3713:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   3714:             $r->print('<form method="post" action="">');
                   3715:             foreach my $key(keys(%$fields)) {
1.358     banghart 3716:                 $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339     banghart 3717:             }
                   3718:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   3719:             $r->print('</form>');
                   3720:         }
                   3721:         $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 3722:         $r->print('<input type="text" name="fieldname" /><br />');
                   3723:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.334     banghart 3724:     }
1.361     albertel 3725:     $r->print('</form>');
1.334     banghart 3726: }
1.416     jms      3727: 
                   3728: 
                   3729: 
1.259     banghart 3730: sub setrestrictmeta {
1.240     banghart 3731:     my ($r)=@_;
1.242     banghart 3732:     my $next_meta;
1.244     banghart 3733:     my $output;
1.245     banghart 3734:     my $item_num;
1.246     banghart 3735:     my $put_result;
1.414     droeschl 3736:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
                   3737:     	text=>"Restrict Metadata"});
1.280     albertel 3738:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 3739:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 3740:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3741:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 3742:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 3743:     my $save_field = '';
1.259     banghart 3744:     if ($env{'form.restrictmeta'}) {
1.254     banghart 3745:         foreach my $field (sort(keys(%env))) {
1.252     banghart 3746:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 3747:                 my $options;
1.252     banghart 3748:                 my $meta_field = $1;
                   3749:                 my $meta_key = $2;
1.253     banghart 3750:                 if ($save_field ne $meta_field) {
1.252     banghart 3751:                     $save_field = $meta_field;
1.253     banghart 3752:             	    if ($env{'form.'.$meta_field.'_stuadd'}) {
1.254     banghart 3753:             	        $options.='stuadd,';
1.446     bisitz   3754:             	    }
1.351     banghart 3755:             	    if ($env{'form.'.$meta_field.'_choices'}) {
                   3756:             	        $options.='choices,';
1.446     bisitz   3757:             	    }
1.351     banghart 3758:             	    if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
1.254     banghart 3759:             	        $options.='onlyone,';
1.446     bisitz   3760:             	    }
1.254     banghart 3761:             	    if ($env{'form.'.$meta_field.'_active'}) {
                   3762:             	        $options.='active,';
1.253     banghart 3763:             	    }
1.337     banghart 3764:             	    if ($env{'form.'.$meta_field.'_deleted'}) {
                   3765:             	        $options.='deleted,';
                   3766:             	    }
1.259     banghart 3767:                     my $name = $save_field;
1.253     banghart 3768:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 3769:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   3770:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 3771:                                                    },$dom,$crs);
1.252     banghart 3772:                 }
                   3773:             }
                   3774:         }
                   3775:     }
1.296     albertel 3776:     &Apache::lonnet::coursedescription($env{'request.course.id'},
                   3777: 				       {'freshen_cache' => 1});
1.335     banghart 3778:     # Get the default metadata fields
1.258     albertel 3779:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 3780:     # Now get possible added metadata fields
1.357     raeburn  3781:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 3782:     my $row_alt = 1;
1.347     banghart 3783:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 3784:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 3785:         if ($field ne 'courserestricted') {
1.346     banghart 3786:             $row_alt = $row_alt ? 0 : 1;
1.347     banghart 3787: 	    $output.= &output_row($r, $field, $metadata_fields{$field});
1.265     banghart 3788: 	}
1.255     banghart 3789:     }
1.351     banghart 3790:     my $buttons = (<<ENDButtons);
                   3791:         <input type="submit" name="restrictmeta" value="Save" />
                   3792:         </form><br />
                   3793:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   3794:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   3795:         </form>
                   3796:         <br />
                   3797:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   3798:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   3799: ENDButtons
1.337     banghart 3800:     my $added_flag = 1;
1.335     banghart 3801:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 3802:         $row_alt = $row_alt ? 0 : 1;
                   3803:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt);
1.335     banghart 3804:     }
1.347     banghart 3805:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   3806:     $r->print(<<ENDenv);
1.259     banghart 3807:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 3808:         $output
1.351     banghart 3809:         $buttons
1.340     banghart 3810:         </form>
1.244     banghart 3811: ENDenv
1.280     albertel 3812:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 3813:     return 'ok';
                   3814: }
1.416     jms      3815: 
                   3816: 
                   3817: 
1.335     banghart 3818: sub get_added_meta_fieldnames {
1.357     raeburn  3819:     my ($cid) = @_;
1.335     banghart 3820:     my %fields;
                   3821:     foreach my $key(%env) {
1.357     raeburn  3822:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 3823:             my $field_name = $1;
                   3824:             my ($display_field_name) = $env{$key};
                   3825:             $fields{$field_name} = $display_field_name;
                   3826:         }
                   3827:     }
                   3828:     return \%fields;
                   3829: }
1.416     jms      3830: 
                   3831: 
                   3832: 
1.339     banghart 3833: sub get_deleted_meta_fieldnames {
1.357     raeburn  3834:     my ($cid) = @_;
1.339     banghart 3835:     my %fields;
                   3836:     foreach my $key(%env) {
1.357     raeburn  3837:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 3838:             my $field_name = $1;
                   3839:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   3840:                 my ($display_field_name) = $env{$key};
                   3841:                 $fields{$field_name} = $display_field_name;
                   3842:             }
                   3843:         }
                   3844:     }
                   3845:     return \%fields;
                   3846: }
1.220     www      3847: sub defaultsetter {
1.280     albertel 3848:     my ($r) = @_;
                   3849: 
1.414     droeschl 3850:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
                   3851:     	text=>"Set Defaults"});
1.446     bisitz   3852:     my $start_page =
1.280     albertel 3853: 	&Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 3854:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.220     www      3855:     $r->print(<<ENDDEFHEAD);
1.280     albertel 3856: $start_page
1.220     www      3857: $breadcrumbs
                   3858: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   3859: ENDDEFHEAD
1.280     albertel 3860: 
                   3861:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3862:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      3863:     my @ids=();
                   3864:     my %typep=();
                   3865:     my %keyp=();
                   3866:     my %allparms=();
                   3867:     my %allparts=();
                   3868:     my %allmaps=();
                   3869:     my %mapp=();
                   3870:     my %symbp=();
                   3871:     my %maptitles=();
                   3872:     my %uris=();
                   3873:     my %keyorder=&standardkeyorder();
                   3874:     my %defkeytype=();
                   3875: 
1.446     bisitz   3876:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.221     www      3877: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   3878: 				\%keyorder,\%defkeytype);
1.224     www      3879:     if ($env{'form.storerules'}) {
                   3880: 	my %newrules=();
                   3881: 	my @delrules=();
1.226     www      3882: 	my %triggers=();
1.225     albertel 3883: 	foreach my $key (keys(%env)) {
                   3884:             if ($key=~/^form\.(\w+)\_action$/) {
1.224     www      3885: 		my $tempkey=$1;
1.226     www      3886: 		my $action=$env{$key};
                   3887:                 if ($action) {
                   3888: 		    $newrules{$tempkey.'_action'}=$action;
                   3889: 		    if ($action ne 'default') {
                   3890: 			my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   3891: 			$triggers{$whichparm}.=$tempkey.':';
                   3892: 		    }
                   3893: 		    $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224     www      3894: 		    if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3895: 			$newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224     www      3896: 			$newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   3897: 			$newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   3898: 			$newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   3899: 		    } else {
                   3900: 			$newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227     www      3901: 			$newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224     www      3902: 		    }
                   3903: 		} else {
1.225     albertel 3904: 		    push(@delrules,$tempkey.'_action');
1.226     www      3905: 		    push(@delrules,$tempkey.'_type');
1.225     albertel 3906: 		    push(@delrules,$tempkey.'_hours');
                   3907: 		    push(@delrules,$tempkey.'_min');
                   3908: 		    push(@delrules,$tempkey.'_sec');
                   3909: 		    push(@delrules,$tempkey.'_value');
1.224     www      3910: 		}
                   3911: 	    }
                   3912: 	}
1.226     www      3913: 	foreach my $key (keys %allparms) {
                   3914: 	    $newrules{$key.'_triggers'}=$triggers{$key};
                   3915: 	}
1.224     www      3916: 	&Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   3917: 	&Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   3918: 	&resetrulescache();
                   3919:     }
1.227     www      3920:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
                   3921: 				       'hours' => 'Hours',
1.221     www      3922: 				       'min' => 'Minutes',
                   3923: 				       'sec' => 'Seconds',
                   3924: 				       'yes' => 'Yes',
                   3925: 				       'no' => 'No');
1.222     www      3926:     my @standardoptions=('','default');
                   3927:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   3928:     my @dateoptions=('','default');
                   3929:     my @datedisplay=('',&mt('Default value when manually setting'));
                   3930:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
                   3931: 	unless ($tempkey) { next; }
                   3932: 	push @standardoptions,'when_setting_'.$tempkey;
                   3933: 	push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   3934: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3935: 	    push @dateoptions,'later_than_'.$tempkey;
                   3936: 	    push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   3937: 	    push @dateoptions,'earlier_than_'.$tempkey;
                   3938: 	    push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
1.446     bisitz   3939: 	}
1.222     www      3940:     }
1.231     www      3941: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   3942: 	  &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 3943:     $r->print("\n".&Apache::loncommon::start_data_table().
                   3944: 	      &Apache::loncommon::start_data_table_header_row().
                   3945: 	      "<th>".&mt('Rule for parameter').'</th><th>'.
                   3946: 	      &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   3947: 	      &Apache::loncommon::end_data_table_header_row());
1.221     www      3948:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222     www      3949: 	unless ($tempkey) { next; }
1.318     albertel 3950: 	$r->print("\n".&Apache::loncommon::start_data_table_row().
                   3951: 		  "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222     www      3952: 	my $action=&rulescache($tempkey.'_action');
                   3953: 	$r->print('<select name="'.$tempkey.'_action">');
                   3954: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3955: 	    for (my $i=0;$i<=$#dateoptions;$i++) {
                   3956: 		if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   3957: 		$r->print("\n<option value='$dateoptions[$i]'".
                   3958: 			  ($dateoptions[$i] eq $action?' selected="selected"':'').
                   3959: 			  ">$datedisplay[$i]</option>");
                   3960: 	    }
                   3961: 	} else {
                   3962: 	    for (my $i=0;$i<=$#standardoptions;$i++) {
                   3963: 		if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   3964: 		$r->print("\n<option value='$standardoptions[$i]'".
                   3965: 			  ($standardoptions[$i] eq $action?' selected="selected"':'').
                   3966: 			  ">$standarddisplay[$i]</option>");
                   3967: 	    }
                   3968: 	}
                   3969: 	$r->print('</select>');
1.227     www      3970: 	unless (&isdateparm($defkeytype{$tempkey})) {
                   3971: 	    $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   3972: 		      '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   3973: 	}
1.222     www      3974: 	$r->print("\n</td><td>\n");
                   3975: 
1.221     www      3976:         if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3977: 	    my $days=&rulescache($tempkey.'_days');
1.222     www      3978: 	    my $hours=&rulescache($tempkey.'_hours');
                   3979: 	    my $min=&rulescache($tempkey.'_min');
                   3980: 	    my $sec=&rulescache($tempkey.'_sec');
1.221     www      3981: 	    $r->print(<<ENDINPUTDATE);
1.227     www      3982: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      3983: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   3984: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   3985: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      3986: ENDINPUTDATE
                   3987: 	} elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      3988:             my $yeschecked='';
                   3989:             my $nochecked='';
1.444     bisitz   3990:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   3991:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
1.222     www      3992: 
1.221     www      3993: 	    $r->print(<<ENDYESNO);
1.444     bisitz   3994: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   3995: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.221     www      3996: ENDYESNO
                   3997:         } else {
1.224     www      3998: 	    $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221     www      3999: 	}
1.318     albertel 4000:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      4001:     }
1.318     albertel 4002:     $r->print(&Apache::loncommon::end_data_table().
1.419     bisitz   4003: 	      "\n".'<input type="submit" name="storerules" value="'.
1.430     schafran 4004: 	      &mt('Save').'" /></form>'."\n".
1.280     albertel 4005: 	      &Apache::loncommon::end_page());
1.220     www      4006:     return;
                   4007: }
1.193     albertel 4008: 
1.290     www      4009: sub components {
1.330     albertel 4010:     my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
                   4011: 
                   4012:     if ($typeflag) {
1.290     www      4013: 	$key=~s/\.type$//;
                   4014:     }
1.330     albertel 4015: 
                   4016:     my ($middle,$part,$name)=
                   4017: 	($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.291     www      4018:     my $issection;
1.330     albertel 4019: 
1.290     www      4020:     my $section=&mt('All Students');
                   4021:     if ($middle=~/^\[(.*)\]/) {
1.291     www      4022: 	$issection=$1;
                   4023: 	$section=&mt('Group/Section').': '.$issection;
1.290     www      4024: 	$middle=~s/^\[(.*)\]//;
                   4025:     }
                   4026:     $middle=~s/\.+$//;
                   4027:     $middle=~s/^\.+//;
1.291     www      4028:     if ($uname) {
                   4029: 	$section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   4030: 	$issection='';
                   4031:     }
1.316     albertel 4032:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   4033:     my $realmdescription=&mt('all resources');
1.290     www      4034:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.316     albertel 4035: 	$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      4036:  	$realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($1);
                   4037:    } elsif ($middle) {
1.290     www      4038: 	my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
1.316     albertel 4039: 	$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      4040: 	$realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      4041:     }
1.291     www      4042:     my $what=$part.'.'.$name;
1.330     albertel 4043:     return ($realm,$section,$name,$part,
1.304     www      4044: 	    $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      4045: }
1.293     www      4046: 
1.328     albertel 4047: my %standard_parms;
1.416     jms      4048: 
                   4049: 
1.328     albertel 4050: sub load_parameter_names {
                   4051:     open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
                   4052:     while (my $configline=<$config>) {
                   4053: 	if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   4054: 	chomp($configline);
                   4055: 	my ($short,$plain)=split(/:/,$configline);
                   4056: 	my (undef,$name,$type)=split(/\&/,$short,3);
                   4057: 	if ($type eq 'display') {
                   4058: 	    $standard_parms{$name} = $plain;
                   4059: 	}
                   4060:     }
                   4061:     close($config);
                   4062:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   4063:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.446     bisitz   4064:     %standard_parms=&Apache::lonlocal::texthash(%standard_parms);
1.328     albertel 4065: }
                   4066: 
1.292     www      4067: sub standard_parameter_names {
                   4068:     my ($name)=@_;
1.328     albertel 4069:     if (!%standard_parms) {
                   4070: 	&load_parameter_names();
                   4071:     }
1.292     www      4072:     if ($standard_parms{$name}) {
1.446     bisitz   4073: 	return $standard_parms{$name};
                   4074:     } else {
                   4075: 	return $name;
1.292     www      4076:     }
                   4077: }
1.290     www      4078: 
1.309     www      4079: 
                   4080: 
1.285     albertel 4081: sub parm_change_log {
1.284     www      4082:     my ($r)=@_;
1.414     droeschl 4083:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
                   4084: 	text=>"Parameter Change Log"});
1.327     albertel 4085:     $r->print(&Apache::loncommon::start_page('Parameter Change Log'));
                   4086:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
                   4087: 
1.286     www      4088:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
                   4089: 				      $env{'course.'.$env{'request.course.id'}.'.domain'},
                   4090: 				      $env{'course.'.$env{'request.course.id'}.'.num'});
1.311     albertel 4091: 
1.301     www      4092:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 4093: 
1.327     albertel 4094:     $r->print('<form action="/adm/parmset?action=parameterchangelog"
                   4095:                      method="post" name="parameterlog">');
1.446     bisitz   4096: 
1.311     albertel 4097:     my %saveable_parameters = ('show' => 'scalar',);
                   4098:     &Apache::loncommon::store_course_settings('parameter_log',
                   4099:                                               \%saveable_parameters);
                   4100:     &Apache::loncommon::restore_course_settings('parameter_log',
                   4101:                                                 \%saveable_parameters);
1.348     www      4102:     $r->print(&Apache::loncommon::display_filter().
1.326     www      4103:               '<label>'.&Apache::lonhtmlcommon::checkbox('includetypes',$env{'form.includetypes'},'1').
                   4104: 	      ' '.&mt('Include parameter types').'</label>'.
1.327     albertel 4105: 	      '<input type="submit" value="'.&mt('Display').'" /></form>');
1.301     www      4106: 
1.291     www      4107:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
                   4108: 						     $env{'course.'.$env{'request.course.id'}.'.domain'});
1.301     www      4109:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
                   4110: 	      '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
                   4111: 	      &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th><th>'.&mt('Announce').'</th>'.
                   4112: 	      &Apache::loncommon::end_data_table_header_row());
1.309     www      4113:     my $shown=0;
1.349     www      4114:     my $folder='';
                   4115:     if ($env{'form.displayfilter'} eq 'currentfolder') {
                   4116: 	my $last='';
                   4117: 	if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   4118: 		&GDBM_READER(),0640)) {
                   4119: 	    $last=$hash{'last_known'};
                   4120: 	    untie(%hash);
                   4121: 	}
                   4122: 	if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   4123:     }
1.446     bisitz   4124:     foreach my $id (sort
1.356     albertel 4125: 		    {
                   4126: 			if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   4127: 			    return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   4128: 			}
                   4129: 			my $aid = (split('00000',$a))[-1];
                   4130: 			my $bid = (split('00000',$b))[-1];
                   4131: 			return $bid<=>$aid;
                   4132: 		    } (keys(%parmlog))) {
1.294     www      4133:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.332     albertel 4134: 	my $count = 0;
1.288     albertel 4135: 	my $time =
1.294     www      4136: 	    &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
1.446     bisitz   4137: 	my $plainname =
1.294     www      4138: 	    &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   4139: 					  $parmlog{$id}{'exe_udom'});
1.446     bisitz   4140: 	my $about_me_link =
1.289     www      4141: 	    &Apache::loncommon::aboutmewrapper($plainname,
1.294     www      4142: 					       $parmlog{$id}{'exe_uname'},
                   4143: 					       $parmlog{$id}{'exe_udom'});
1.293     www      4144: 	my $send_msg_link='';
1.446     bisitz   4145: 	if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.294     www      4146: 	     || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
1.293     www      4147: 	    $send_msg_link ='<br />'.
1.288     albertel 4148: 		&Apache::loncommon::messagewrapper(&mt('Send message'),
1.294     www      4149: 						   $parmlog{$id}{'exe_uname'},
                   4150: 						   $parmlog{$id}{'exe_udom'});
1.288     albertel 4151: 	}
1.301     www      4152: 	my $row_start=&Apache::loncommon::start_data_table_row();
1.290     www      4153: 	my $makenewrow=0;
                   4154: 	my %istype=();
1.332     albertel 4155: 	my $output;
1.293     www      4156: 	foreach my $changed (reverse(sort(@changes))) {
1.330     albertel 4157:             my $value=$parmlog{$id}{'logentry'}{$changed};
1.331     albertel 4158: 	    my $typeflag = ($changed =~/\.type$/ &&
                   4159: 			    !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 4160:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
                   4161: 		&components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
1.349     www      4162: 	    if ($env{'form.displayfilter'} eq 'currentfolder') {
                   4163: 		if ($folder) {
                   4164: 		    if ($middle!~/^\Q$folder\E/) { next; }
                   4165: 		}
                   4166: 	    }
1.326     www      4167: 	    if ($typeflag) {
1.446     bisitz   4168: 		$istype{$parmname}=$value;
                   4169: 		if (!$env{'form.includetypes'}) { next; }
1.326     www      4170: 	    }
1.332     albertel 4171: 	    $count++;
                   4172: 	    if ($makenewrow) {
                   4173: 		$output .= $row_start;
                   4174: 	    } else {
                   4175: 		$makenewrow=1;
                   4176: 	    }
                   4177: 	    $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
1.292     www      4178: 		      &standard_parameter_names($parmname).'</td><td>'.
1.332     albertel 4179: 		      ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
1.291     www      4180: 	    my $stillactive=0;
1.332     albertel 4181: 	    if ($parmlog{$id}{'delflag'}) {
                   4182: 		$output .= &mt('Deleted');
1.288     albertel 4183: 	    } else {
1.290     www      4184: 		if ($typeflag) {
1.332     albertel 4185: 		    $output .= &mt('Type: [_1]',&standard_parameter_names($value));
1.290     www      4186: 		} else {
1.291     www      4187: 		    my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   4188: 						      $uname,$udom,$issection,$issection,$courseopt);
                   4189: 		    if (&isdateparm($istype{$parmname})) {
1.332     albertel 4190: 			$output .= &Apache::lonlocal::locallocaltime($value);
1.291     www      4191: 		    } else {
1.332     albertel 4192: 			$output .= $value;
1.291     www      4193: 		    }
                   4194: 		    if ($value ne $all[$level]) {
1.332     albertel 4195: 			$output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
1.291     www      4196: 		    } else {
                   4197: 			$stillactive=1;
                   4198: 		    }
1.290     www      4199: 		}
1.288     albertel 4200: 	    }
1.332     albertel 4201: 	    $output .= '</td><td>';
1.291     www      4202: 	    if ($stillactive) {
1.304     www      4203: 		my $title=&mt('Changed [_1]',&standard_parameter_names($parmname));
                   4204:                 my $description=&mt('Changed [_1] for [_2] to [_3]',&standard_parameter_names($parmname),$realmdescription,
                   4205: 				    (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
1.292     www      4206: 		if (($uname) && ($udom)) {
1.446     bisitz   4207: 		    $output .=
1.332     albertel 4208: 			&Apache::loncommon::messagewrapper('Notify User',
                   4209: 							   $uname,$udom,$title,
                   4210: 							   $description);
1.292     www      4211: 		} else {
1.446     bisitz   4212: 		    $output .=
1.332     albertel 4213: 			&Apache::lonrss::course_blog_link($id,$title,
                   4214: 							  $description);
1.292     www      4215: 		}
1.291     www      4216: 	    }
1.332     albertel 4217: 	    $output .= '</td>'.&Apache::loncommon::end_data_table_row();
1.288     albertel 4218: 	}
1.349     www      4219:         if ($env{'form.displayfilter'} eq 'containing') {
                   4220: 	    my $wholeentry=$about_me_link.':'.
                   4221: 		$parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   4222: 		$output;
1.446     bisitz   4223: 	    if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.349     www      4224: 	}
                   4225:         if ($count) {
                   4226: 	    $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
1.332     albertel 4227:                        <td rowspan="'.$count.'">'.$about_me_link.
                   4228: 		  '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   4229: 			          ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   4230: 		  $send_msg_link.'</td>'.$output);
1.349     www      4231: 	    $shown++;
                   4232: 	}
1.446     bisitz   4233: 	if (!($env{'form.show'} eq &mt('all')
1.311     albertel 4234: 	      || $shown<=$env{'form.show'})) { last; }
1.286     www      4235:     }
1.301     www      4236:     $r->print(&Apache::loncommon::end_data_table());
1.284     www      4237:     $r->print(&Apache::loncommon::end_page());
                   4238: }
                   4239: 
1.437     raeburn  4240: sub update_slots {
                   4241:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   4242:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   4243:     if (!keys(%slot)) {
                   4244:         return 'error: slot does not exist';
                   4245:     }
                   4246:     my $max=$slot{'maxspace'};
                   4247:     if (!defined($max)) { $max=99999; }
                   4248: 
                   4249:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   4250:                                        "^$slot_name\0");
                   4251:     my ($tmp)=%consumed;
                   4252:     if ($tmp=~/^error: 2 / ) {
                   4253:         return 'error: unable to determine current slot status';
                   4254:     }
                   4255:     my $last=0;
                   4256:     foreach my $key (keys(%consumed)) {
                   4257:         my $num=(split('\0',$key))[1];
                   4258:         if ($num > $last) { $last=$num; }
                   4259:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4260:             return 'ok';
                   4261:         }
                   4262:     }
                   4263: 
                   4264:     if (scalar(keys(%consumed)) >= $max) {
                   4265:         return 'error: no space left in slot';
                   4266:     }
                   4267:     my $wanted=$last+1;
                   4268: 
                   4269:     my %reservation=('name'      => $uname.':'.$udom,
                   4270:                      'timestamp' => time,
                   4271:                      'symb'      => $symb);
                   4272: 
                   4273:     my $success=&Apache::lonnet::newput('slot_reservations',
                   4274:                                         {"$slot_name\0$wanted" =>
                   4275:                                              \%reservation},
                   4276:                                         $cdom, $cnum);
1.438     raeburn  4277:     if ($success eq 'ok') {
                   4278:         my %storehash = (
                   4279:                           symb    => $symb,
                   4280:                           slot    => $slot_name,
                   4281:                           action  => 'reserve',
                   4282:                           context => 'parameter',
                   4283:                         );
                   4284:         &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4285:                                         '',$uname,$udom,$cnum,$cdom);
                   4286: 
                   4287:         &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4288:                                         '',$uname,$udom,$uname,$udom);
                   4289:     }
1.437     raeburn  4290:     return $success;
                   4291: }
                   4292: 
                   4293: sub delete_slots {
                   4294:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   4295:     my $delresult;
                   4296:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   4297:                                          $cnum, "^$slot_name\0");
                   4298:     if (&Apache::lonnet::error(%consumed)) {
                   4299:         return 'error: unable to determine current slot status';
                   4300:     }
                   4301:     my ($tmp)=%consumed;
                   4302:     if ($tmp=~/^error: 2 /) {
                   4303:         return 'error: unable to determine current slot status';
                   4304:     }
                   4305:     foreach my $key (keys(%consumed)) {
                   4306:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   4307:             my $num=(split('\0',$key))[1];
                   4308:             my $entry = $slot_name.'\0'.$num;
                   4309:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   4310:                                               $cdom,$cnum);
                   4311:             if ($delresult eq 'ok') {
                   4312:                 my %storehash = (
                   4313:                                   symb    => $symb,
                   4314:                                   slot    => $slot_name,
                   4315:                                   action  => 'release',
                   4316:                                   context => 'parameter',
                   4317:                                 );
                   4318:                 &Apache::lonnet::instructor_log('slotreservationslog',\%storehash,
                   4319:                                                 1,$uname,$udom,$cnum,$cdom);
1.438     raeburn  4320:                 &Apache::lonnet::instructor_log($cdom.'_'.$cnum.'_slotlog',\%storehash,
                   4321:                                                 1,$uname,$udom,$uname,$udom);
1.437     raeburn  4322:             }
                   4323:         }
                   4324:     }
                   4325:     return $delresult;
                   4326: }
                   4327: 
1.355     albertel 4328: sub check_for_course_info {
                   4329:     my $navmap = Apache::lonnavmaps::navmap->new();
                   4330:     return 1 if ($navmap);
                   4331:     return 0;
                   4332: }
                   4333: 
1.259     banghart 4334: 
1.30      www      4335: sub handler {
1.43      albertel 4336:     my $r=shift;
1.30      www      4337: 
1.376     albertel 4338:     &reset_caches();
                   4339: 
1.414     droeschl 4340:     &Apache::loncommon::content_type($r,'text/html');
                   4341:     $r->send_http_header;
                   4342:     return OK if $r->header_only;
                   4343: 
1.193     albertel 4344:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205     www      4345: 					    ['action','state',
                   4346:                                              'pres_marker',
                   4347:                                              'pres_value',
1.206     www      4348:                                              'pres_type',
1.390     www      4349:                                              'udom','uname','symb','serial','timebase']);
1.131     www      4350: 
1.83      bowersj2 4351: 
1.193     albertel 4352:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 4353:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
                   4354: 					    text=>"Parameter Manager",
1.204     www      4355: 					    faq=>10,
1.324     www      4356: 					    bug=>'Instructor Interface',
1.442     droeschl 4357:                                             help =>
                   4358:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      4359: 
1.30      www      4360: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 4361:     my $parm_permission =
                   4362: 	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190     albertel 4363: 	 &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193     albertel 4364: 				  $env{'request.course.sec'}));
1.355     albertel 4365:     my $exists = &check_for_course_info();
                   4366: 
                   4367:     if ($env{'request.course.id'} &&  $parm_permission && $exists) {
1.193     albertel 4368:         #
                   4369:         # Main switch on form.action and form.state, as appropriate
                   4370:         #
                   4371:         # Check first if coming from someone else headed directly for
                   4372:         #  the table mode
                   4373:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   4374: 	     && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   4375: 	    &assessparms($r);
                   4376:         } elsif (! exists($env{'form.action'})) {
                   4377:             &print_main_menu($r,$parm_permission);
1.414     droeschl 4378:         } elsif ($env{'form.action'} eq 'setoverview') {
1.121     www      4379: 	    &overview($r);
1.414     droeschl 4380: 	} elsif ($env{'form.action'} eq 'addmetadata') {
1.334     banghart 4381: 	    &addmetafield($r);
1.414     droeschl 4382: 	} elsif ($env{'form.action'} eq 'ordermetadata') {
1.340     banghart 4383: 	    &order_meta_fields($r);
1.414     droeschl 4384:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.259     banghart 4385: 	    &setrestrictmeta($r);
1.414     droeschl 4386:         } elsif ($env{'form.action'} eq 'newoverview') {
1.208     www      4387: 	    &newoverview($r);
1.414     droeschl 4388:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.220     www      4389: 	    &defaultsetter($r);
1.414     droeschl 4390: 	} elsif ($env{'form.action'} eq 'settable') {
1.121     www      4391: 	    &assessparms($r);
1.414     droeschl 4392:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.285     albertel 4393: 	    &parm_change_log($r);
1.414     droeschl 4394:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.333     albertel 4395: 	    &clean_parameters($r);
1.414     droeschl 4396:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      4397:             &date_shift_one($r);
1.414     droeschl 4398:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      4399:             &date_shift_two($r);
1.414     droeschl 4400: 	} elsif ($env{'form.action'} eq 'categorizecourse') {
1.403     raeburn  4401:             &assign_course_categories($r);
1.446     bisitz   4402:         }
1.43      albertel 4403:     } else {
1.1       www      4404: # ----------------------------- Not in a course, or not allowed to modify parms
1.355     albertel 4405: 	if ($exists) {
                   4406: 	    $env{'user.error.msg'}=
                   4407: 		"/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   4408: 	} else {
                   4409: 	    $env{'user.error.msg'}=
                   4410: 		"/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   4411: 	}
1.43      albertel 4412: 	return HTTP_NOT_ACCEPTABLE;
                   4413:     }
1.376     albertel 4414:     &reset_caches();
                   4415: 
1.43      albertel 4416:     return OK;
1.1       www      4417: }
                   4418: 
                   4419: 1;
                   4420: __END__
                   4421: 
                   4422: 

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