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

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

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