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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.300   ! albertel    4: # $Id: lonparmset.pm,v 1.299 2006/05/09 14:38:10 albertel 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: 
                     49: =cut
                     50: 
                     51: ###################################################################
                     52: ###################################################################
1.1       www        53: 
                     54: package Apache::lonparmset;
                     55: 
                     56: use strict;
                     57: use Apache::lonnet;
                     58: use Apache::Constants qw(:common :http REDIRECT);
1.88      matthew    59: use Apache::lonhtmlcommon();
1.36      albertel   60: use Apache::loncommon;
1.1       www        61: use GDBM_File;
1.57      albertel   62: use Apache::lonhomework;
                     63: use Apache::lonxml;
1.130     www        64: use Apache::lonlocal;
1.197     www        65: use Apache::lonnavmaps;
1.1       www        66: 
1.198     www        67: # --- Caches local to lonparmset
1.2       www        68: 
1.199     www        69: my $parmhashid;
                     70: my %parmhash;
1.201     www        71: my $symbsid;
                     72: my %symbs;
1.221     www        73: my $rulesid;
                     74: my %rules;
1.198     www        75: 
                     76: # --- end local caches
                     77: 
1.59      matthew    78: ##################################################
                     79: ##################################################
                     80: 
                     81: =pod
                     82: 
                     83: =item parmval
                     84: 
                     85: Figure out a cascading parameter.
                     86: 
1.71      albertel   87: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   88:          $id   - a bighash Id number
1.71      albertel   89:          $def  - the resource's default value   'stupid emacs
                     90: 
1.269     raeburn    91: Returns:  A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 14 possible levels
1.71      albertel   92: 
1.269     raeburn    93: 14 - General Course
                     94: 13 - Map or Folder level in course
                     95: 12- resource default
                     96: 11- map default
                     97: 10 - resource level in course
                     98: 9 - General for section
                     99: 8 - Map or Folder level for section
                    100: 7 - resource level in section
                    101: 6 - General for group
                    102: 5 - Map or Folder level for group
                    103: 4 - resource level in group
1.71      albertel  104: 3 - General for specific student
1.82      www       105: 2 - Map or Folder level for specific student
1.71      albertel  106: 1 - resource level for specific student
1.2       www       107: 
1.59      matthew   108: =cut
                    109: 
                    110: ##################################################
1.2       www       111: sub parmval {
1.275     raeburn   112:     my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
                    113:     return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
                    114:                                                            $cgroup,$courseopt);
1.201     www       115: }
                    116: 
                    117: sub parmval_by_symb {
1.275     raeburn   118:     my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.198     www       119: # load caches
                    120:     &cacheparmhash();
1.200     www       121: 
                    122:     my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
                    123: 
1.8       www       124:     my $result='';
1.44      albertel  125:     my @outpar=();
1.2       www       126: # ----------------------------------------------------- Cascading lookup scheme
1.201     www       127:     my $map=(&Apache::lonnet::decode_symb($symb))[0];    
1.10      www       128: 
1.201     www       129:     my $symbparm=$symb.'.'.$what;
                    130:     my $mapparm=$map.'___(all).'.$what;
1.10      www       131: 
1.269     raeburn   132:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
                    133:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    134:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    135: 
1.190     albertel  136:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
                    137:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    138:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    139: 
                    140:     my $courselevel=$env{'request.course.id'}.'.'.$what;
                    141:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    142:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2       www       143: 
1.11      www       144: 
1.182     albertel  145: # --------------------------------------------------------- first, check course
1.11      www       146: 
1.200     www       147:     if (defined($$courseopt{$courselevel})) {
1.269     raeburn   148: 	$outpar[14]=$$courseopt{$courselevel};
                    149: 	$result=14;
1.43      albertel  150:     }
1.11      www       151: 
1.200     www       152:     if (defined($$courseopt{$courselevelm})) {
1.269     raeburn   153: 	$outpar[13]=$$courseopt{$courselevelm};
                    154: 	$result=13;
1.43      albertel  155:     }
1.11      www       156: 
1.182     albertel  157: # ------------------------------------------------------- second, check default
                    158: 
1.269     raeburn   159:     if (defined($def)) { $outpar[12]=$def; $result=12; }
1.182     albertel  160: 
                    161: # ------------------------------------------------------ third, check map parms
                    162: 
                    163:     my $thisparm=$parmhash{$symbparm};
1.269     raeburn   164:     if (defined($thisparm)) { $outpar[11]=$thisparm; $result=11; }
1.182     albertel  165: 
1.200     www       166:     if (defined($$courseopt{$courselevelr})) {
1.269     raeburn   167: 	$outpar[10]=$$courseopt{$courselevelr};
                    168: 	$result=10;
1.43      albertel  169:     }
1.11      www       170: 
1.182     albertel  171: # ------------------------------------------------------ fourth, back to course
1.71      albertel  172:     if (defined($csec)) {
1.200     www       173:         if (defined($$courseopt{$seclevel})) {
1.269     raeburn   174: 	    $outpar[9]=$$courseopt{$seclevel};
                    175: 	    $result=9;
1.43      albertel  176: 	}
1.200     www       177:         if (defined($$courseopt{$seclevelm})) {
1.269     raeburn   178: 	    $outpar[8]=$$courseopt{$seclevelm};
                    179: 	    $result=8;
1.43      albertel  180: 	}
                    181: 
1.200     www       182:         if (defined($$courseopt{$seclevelr})) {
1.269     raeburn   183: 	    $outpar[7]=$$courseopt{$seclevelr};
                    184: 	    $result=7;
1.43      albertel  185: 	}
                    186:     }
1.275     raeburn   187: # ------------------------------------------------------ fifth, check course group
1.269     raeburn   188:     if (defined($cgroup)) {
                    189:         if (defined($$courseopt{$grplevel})) {
                    190:             $outpar[6]=$$courseopt{$grplevel};
                    191:             $result=6;
                    192:         }
                    193:         if (defined($$courseopt{$grplevelm})) {
                    194:             $outpar[5]=$$courseopt{$grplevelm};
                    195:             $result=5;
                    196:         }
                    197:         if (defined($$courseopt{$grplevelr})) {
                    198:             $outpar[4]=$$courseopt{$grplevelr};
                    199:             $result=4;
                    200:         }
                    201:     }
1.11      www       202: 
1.182     albertel  203: # ---------------------------------------------------------- fifth, check user
1.11      www       204: 
1.71      albertel  205:     if (defined($uname)) {
1.200     www       206: 	if (defined($$useropt{$courselevel})) {
                    207: 	    $outpar[3]=$$useropt{$courselevel};
1.43      albertel  208: 	    $result=3;
                    209: 	}
1.10      www       210: 
1.200     www       211: 	if (defined($$useropt{$courselevelm})) {
                    212: 	    $outpar[2]=$$useropt{$courselevelm};
1.43      albertel  213: 	    $result=2;
                    214: 	}
1.2       www       215: 
1.200     www       216: 	if (defined($$useropt{$courselevelr})) {
                    217: 	    $outpar[1]=$$useropt{$courselevelr};
1.43      albertel  218: 	    $result=1;
                    219: 	}
                    220:     }
1.44      albertel  221:     return ($result,@outpar);
1.2       www       222: }
                    223: 
1.198     www       224: sub resetparmhash {
                    225:     $parmhashid='';
                    226: }
                    227: 
                    228: sub cacheparmhash {
                    229:     if ($parmhashid eq  $env{'request.course.fn'}) { return; }
                    230:     my %parmhashfile;
                    231:     if (tie(%parmhashfile,'GDBM_File',
                    232: 	      $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
                    233: 	%parmhash=%parmhashfile;
                    234: 	untie %parmhashfile;
                    235: 	$parmhashid=$env{'request.course.fn'};
                    236:     }
                    237: }
                    238: 
1.203     www       239: sub resetsymbcache {
                    240:     $symbsid='';
                    241: }
                    242: 
1.201     www       243: sub symbcache {
                    244:     my $id=shift;
                    245:     if ($symbsid ne $env{'request.course.id'}) {
                    246: 	%symbs=();
                    247:     }
                    248:     unless ($symbs{$id}) {
                    249: 	my $navmap = Apache::lonnavmaps::navmap->new();
                    250: 	if ($id=~/\./) {
                    251: 	    my $resource=$navmap->getById($id);
                    252: 	    $symbs{$id}=$resource->symb();
                    253: 	} else {
                    254: 	    my $resource=$navmap->getByMapPc($id);
                    255: 	    $symbs{$id}=&Apache::lonnet::declutter($resource->src());
                    256: 	}
                    257: 	$symbsid=$env{'request.course.id'};
                    258:     }
                    259:     return $symbs{$id};
                    260: }
                    261: 
1.221     www       262: sub resetrulescache {
                    263:     $rulesid='';
                    264: }
                    265: 
                    266: sub rulescache {
                    267:     my $id=shift;
                    268:     if ($rulesid ne $env{'request.course.id'}) {
                    269: 	%rules=();
                    270:     }
1.224     www       271:     unless (defined($rules{$id})) {
1.221     www       272: 	my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    273: 	my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.224     www       274: 	%rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
1.221     www       275: 	$rulesid=$env{'request.course.id'};
                    276:     }
                    277:     return $rules{$id};
                    278: }
                    279: 
1.229     www       280: sub preset_defaults {
                    281:     my $type=shift;
                    282:     if (&rulescache($type.'_action') eq 'default') {
                    283: # yes, there is something
                    284: 	return (&rulescache($type.'_hours'),
                    285: 		&rulescache($type.'_min'),
                    286: 		&rulescache($type.'_sec'),
                    287: 		&rulescache($type.'_value'));
                    288:     } else {
                    289: # nothing there or something else
                    290: 	return ('','','','','');
                    291:     }
                    292: }
                    293: 
1.186     www       294: ##################################################
1.277     www       295: 
                    296: sub date_sanity_info {
                    297:    my $checkdate=shift;
                    298:    unless ($checkdate) { return ''; }
                    299:    my $result='';
                    300:    my $crsprefix='course.'.$env{'request.course.id'}.'.';
                    301:    if ($env{$crsprefix.'default_enrollment_end_date'}) {
                    302:       if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
                    303:          $result.='<br />'.&mt('After course enrollment end!');
                    304:       }
                    305:    }
                    306:    if ($env{$crsprefix.'default_enrollment_start_date'}) {
                    307:       if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
                    308:          $result.='<br />'.&mt('Before course enrollment start!');
                    309:       }
                    310:    }
                    311:    return $result;
                    312: }
                    313: ##################################################
1.186     www       314: ##################################################
                    315: #
1.197     www       316: # Store a parameter by ID
1.186     www       317: #
                    318: # Takes
                    319: # - resource id
                    320: # - name of parameter
                    321: # - level
                    322: # - new value
                    323: # - new type
1.187     www       324: # - username
                    325: # - userdomain
                    326: 
1.186     www       327: sub storeparm {
1.269     raeburn   328:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275     raeburn   329:     &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197     www       330: }
                    331: 
                    332: #
                    333: # Store a parameter by symb
                    334: #
                    335: # Takes
                    336: # - symb
                    337: # - name of parameter
                    338: # - level
                    339: # - new value
                    340: # - new type
                    341: # - username
                    342: # - userdomain
                    343: 
1.226     www       344: my %recstack;
1.197     www       345: sub storeparm_by_symb {
1.275     raeburn   346:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226     www       347:     unless ($recflag) {
                    348: # first time call
                    349: 	%recstack=();
                    350: 	$recflag=1;
                    351:     }
                    352: # store parameter
                    353:     &storeparm_by_symb_inner
1.269     raeburn   354: 	($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.266     www       355: # don't do anything if parameter was reset
                    356:     unless ($nval) { return; }
1.226     www       357:     my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
                    358: # remember that this was set
                    359:     $recstack{$parm}=1;
                    360: # what does this trigger?
                    361:     foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
                    362: # don't backfire
                    363:        unless ((!$triggered) || ($recstack{$triggered})) {
                    364: 	   my $action=&rulescache($triggered.'_action');
                    365: 	   my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                    366: # set triggered parameter on same level
                    367: 	   my $newspnam=$prefix.$triggered;
1.227     www       368: 	   my $newvalue='';
1.228     www       369: 	   my $active=1;
                    370: 	   if ($action=~/^when\_setting/) {
                    371: # are there restrictions?
                    372: 	       if (&rulescache($triggered.'_triggervalue')=~/\w/) {
                    373: 		   $active=0;
                    374: 		   foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
                    375: 		       if (lc($possiblevalue) eq lc($nval)) { $active=1; }
                    376: 		   }
                    377: 	       }
                    378: 	       $newvalue=&rulescache($triggered.'_value');
1.227     www       379: 	   } else {
                    380: 	       my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
1.228     www       381: 	       if ($action=~/^later\_than/) {
                    382: 		   $newvalue=$nval+$totalsecs;
                    383: 	       } else {
                    384: 		   $newvalue=$nval-$totalsecs;
                    385: 	       }
                    386: 	   }
                    387: 	   if ($active) {
                    388: 	       &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
1.275     raeburn   389: 				   $uname,$udom,$csec,$recflag,$cgroup);
1.227     www       390: 	   }
1.226     www       391:        }
                    392:     }
                    393:     return '';
                    394: }
                    395: 
1.293     www       396: sub log_parmset {
                    397:     return &Apache::lonnet::instructor_log('parameterlog',@_);
1.284     www       398: }
                    399: 
1.226     www       400: sub storeparm_by_symb_inner {
1.197     www       401: # ---------------------------------------------------------- Get symb, map, etc
1.269     raeburn   402:     my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197     www       403: # ---------------------------------------------------------- Construct prefixes
1.186     www       404:     $spnam=~s/\_([^\_]+)$/\.$1/;
1.197     www       405:     my $map=(&Apache::lonnet::decode_symb($symb))[0];    
                    406:     my $symbparm=$symb.'.'.$spnam;
                    407:     my $mapparm=$map.'___(all).'.$spnam;
                    408: 
1.269     raeburn   409:     my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
                    410:     my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
                    411:     my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
                    412: 
1.190     albertel  413:     my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    414:     my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    415:     my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.186     www       416:     
1.190     albertel  417:     my $courselevel=$env{'request.course.id'}.'.'.$spnam;
                    418:     my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
                    419:     my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.186     www       420:     
                    421:     my $storeunder='';
1.269     raeburn   422:     if (($snum==14) || ($snum==3)) { $storeunder=$courselevel; }
                    423:     if (($snum==13) || ($snum==2)) { $storeunder=$courselevelm; }
                    424:     if (($snum==10) || ($snum==1)) { $storeunder=$courselevelr; }
                    425:     if ($snum==9) { $storeunder=$seclevel; }
                    426:     if ($snum==8) { $storeunder=$seclevelm; }
                    427:     if ($snum==7) { $storeunder=$seclevelr; }
                    428:     if ($snum==6) { $storeunder=$grplevel; }
                    429:     if ($snum==5) { $storeunder=$grplevelm; }
                    430:     if ($snum==4) { $storeunder=$grplevelr; }
                    431: 
1.186     www       432:     
                    433:     my $delete;
                    434:     if ($nval eq '') { $delete=1;}
                    435:     my %storecontent = ($storeunder         => $nval,
                    436: 			$storeunder.'.type' => $ntype);
                    437:     my $reply='';
                    438:     if ($snum>3) {
                    439: # ---------------------------------------------------------------- Store Course
                    440: #
1.200     www       441: 	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    442: 	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186     www       443: # Expire sheets
                    444: 	&Apache::lonnet::expirespread('','','studentcalc');
1.269     raeburn   445: 	if (($snum==10) || ($snum==7) || ($snum==4)) {
1.197     www       446: 	    &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.269     raeburn   447: 	} elsif (($snum==11) || ($snum==8) || ($snum==5)) {
1.197     www       448: 	    &Apache::lonnet::expirespread('','','assesscalc',$map);
1.186     www       449: 	} else {
                    450: 	    &Apache::lonnet::expirespread('','','assesscalc');
                    451: 	}
                    452: # Store parameter
                    453: 	if ($delete) {
                    454: 	    $reply=&Apache::lonnet::del
1.200     www       455: 		('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.290     www       456:             &log_parmset(\%storecontent,1);
1.186     www       457: 	} else {
                    458: 	    $reply=&Apache::lonnet::cput
1.200     www       459: 		('resourcedata',\%storecontent,$cdom,$cnum);
1.290     www       460: 	    &log_parmset(\%storecontent);
1.186     www       461: 	}
1.200     www       462: 	&Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186     www       463:     } else {
                    464: # ------------------------------------------------------------------ Store User
                    465: #
                    466: # Expire sheets
                    467: 	&Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    468: 	if ($snum==1) {
                    469: 	    &Apache::lonnet::expirespread
1.197     www       470: 		($uname,$udom,'assesscalc',$symb);
1.186     www       471: 	} elsif ($snum==2) {
                    472: 	    &Apache::lonnet::expirespread
1.197     www       473: 		($uname,$udom,'assesscalc',$map);
1.186     www       474: 	} else {
                    475: 	    &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    476: 	}
                    477: # Store parameter
                    478: 	if ($delete) {
                    479: 	    $reply=&Apache::lonnet::del
                    480: 		('resourcedata',[keys(%storecontent)],$udom,$uname);
1.290     www       481: 	    &log_parmset(\%storecontent,1,$uname,$udom);
1.186     www       482: 	} else {
                    483: 	    $reply=&Apache::lonnet::cput
                    484: 		('resourcedata',\%storecontent,$udom,$uname);
1.290     www       485: 	    &log_parmset(\%storecontent,0,$uname,$udom);
1.186     www       486: 	}
1.191     albertel  487: 	&Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186     www       488:     }
                    489:     
                    490:     if ($reply=~/^error\:(.*)/) {
                    491: 	return "<font color=red>Write Error: $1</font>";
                    492:     }
                    493:     return '';
                    494: }
                    495: 
1.59      matthew   496: ##################################################
                    497: ##################################################
                    498: 
                    499: =pod
                    500: 
                    501: =item valout
                    502: 
                    503: Format a value for output.
                    504: 
                    505: Inputs:  $value, $type
                    506: 
                    507: Returns: $value, formatted for output.  If $type indicates it is a date,
                    508: localtime($value) is returned.
1.9       www       509: 
1.59      matthew   510: =cut
                    511: 
                    512: ##################################################
                    513: ##################################################
1.9       www       514: sub valout {
                    515:     my ($value,$type)=@_;
1.59      matthew   516:     my $result = '';
                    517:     # Values of zero are valid.
                    518:     if (! $value && $value ne '0') {
1.71      albertel  519: 	$result = '&nbsp;&nbsp;';
1.59      matthew   520:     } else {
1.66      www       521:         if ($type eq 'date_interval') {
                    522:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
                    523:             $year=$year-70;
                    524:             $mday--;
                    525:             if ($year) {
                    526: 		$result.=$year.' yrs ';
                    527:             }
                    528:             if ($mon) {
                    529: 		$result.=$mon.' mths ';
                    530:             }
                    531:             if ($mday) {
                    532: 		$result.=$mday.' days ';
                    533:             }
                    534:             if ($hour) {
                    535: 		$result.=$hour.' hrs ';
                    536:             }
                    537:             if ($min) {
                    538: 		$result.=$min.' mins ';
                    539:             }
                    540:             if ($sec) {
                    541: 		$result.=$sec.' secs ';
                    542:             }
                    543:             $result=~s/\s+$//;
1.213     www       544:         } elsif (&isdateparm($type)) {
1.277     www       545:             $result = localtime($value).&date_sanity_info($value);
1.59      matthew   546:         } else {
                    547:             $result = $value;
                    548:         }
                    549:     }
                    550:     return $result;
1.9       www       551: }
                    552: 
1.59      matthew   553: ##################################################
                    554: ##################################################
                    555: 
                    556: =pod
1.5       www       557: 
1.59      matthew   558: =item plink
                    559: 
                    560: Produces a link anchor.
                    561: 
                    562: Inputs: $type,$dis,$value,$marker,$return,$call
                    563: 
                    564: Returns: scalar with html code for a link which will envoke the 
                    565: javascript function 'pjump'.
                    566: 
                    567: =cut
                    568: 
                    569: ##################################################
                    570: ##################################################
1.5       www       571: sub plink {
                    572:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       573:     my $winvalue=$value;
                    574:     unless ($winvalue) {
1.213     www       575: 	if (&isdateparm($type)) {
1.190     albertel  576:             $winvalue=$env{'form.recent_'.$type};
1.23      www       577:         } else {
1.190     albertel  578:             $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23      www       579:         }
                    580:     }
1.229     www       581:     my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
                    582:     my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
                    583:     unless (defined($winvalue)) { $winvalue=$val; }
1.270     www       584:     return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$marker.'" /></td></tr><tr><td align="center">'.
1.43      albertel  585: 	'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1.229     www       586: 	    .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
1.270     www       587: 		&valout($value,$type).'</a></td></tr></table>';
1.5       www       588: }
                    589: 
1.280     albertel  590: sub page_js {
                    591: 
1.81      www       592:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew   593:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280     albertel  594: 
                    595:     return(<<ENDJS);
                    596: <script type="text/javascript">
1.44      albertel  597: 
                    598:     function pclose() {
                    599:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    600:                  "height=350,width=350,scrollbars=no,menubar=no");
                    601:         parmwin.close();
                    602:     }
                    603: 
1.88      matthew   604:     $pjump_def
1.44      albertel  605: 
                    606:     function psub() {
                    607:         pclose();
                    608:         if (document.parmform.pres_marker.value!='') {
                    609:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    610:             var typedef=new Array();
                    611:             typedef=document.parmform.pres_type.value.split('_');
                    612:            if (document.parmform.pres_type.value!='') {
                    613:             if (typedef[0]=='date') {
                    614:                 eval('document.parmform.recent_'+
                    615:                      document.parmform.pres_type.value+
                    616: 		     '.value=document.parmform.pres_value.value;');
                    617:             } else {
                    618:                 eval('document.parmform.recent_'+typedef[0]+
                    619: 		     '.value=document.parmform.pres_value.value;');
                    620:             }
                    621: 	   }
                    622:             document.parmform.submit();
                    623:         } else {
                    624:             document.parmform.pres_value.value='';
                    625:             document.parmform.pres_marker.value='';
                    626:         }
                    627:     }
                    628: 
1.57      albertel  629:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                    630:         var options = "width=" + w + ",height=" + h + ",";
                    631:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                    632:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                    633:         var newWin = window.open(url, wdwName, options);
                    634:         newWin.focus();
                    635:     }
1.44      albertel  636: </script>
1.81      www       637: $selscript
1.280     albertel  638: ENDJS
                    639: 
                    640: }
                    641: sub startpage {
                    642:     my ($r) = @_;
1.281     albertel  643: 
1.282     albertel  644:     my %loaditems = ('onunload' => "pclose()",
1.283     albertel  645: 		     'onload'   => "group_or_section('cgroup')",);
1.280     albertel  646: 
1.281     albertel  647:     my $start_page = 
                    648: 	&Apache::loncommon::start_page('Set/Modify Course Parameters',
                    649: 				       &page_js(),
1.282     albertel  650: 				       {'add_entries' => \%loaditems,});
1.280     albertel  651:     my $breadcrumbs = 
1.298     albertel  652: 	&Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting');
1.280     albertel  653:     $r->print(<<ENDHEAD);
1.281     albertel  654: $start_page
1.193     albertel  655: $breadcrumbs
                    656: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.280     albertel  657: <input type="hidden" value='' name="pres_value" />
                    658: <input type="hidden" value='' name="pres_type" />
                    659: <input type="hidden" value='' name="pres_marker" />
                    660: <input type="hidden" value='1' name="prevvisit" />
1.44      albertel  661: ENDHEAD
                    662: }
                    663: 
1.209     www       664: 
1.44      albertel  665: sub print_row {
1.201     www       666:     my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.275     raeburn   667: 	$defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups)=@_;
                    668:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    669:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    670:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.66      www       671: # get the values for the parameter in cascading order
                    672: # empty levels will remain empty
1.44      albertel  673:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.275     raeburn   674: 	  $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       675: # get the type for the parameters
                    676: # problem: these may not be set for all levels
                    677:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275     raeburn   678:                                           $$name{$which}.'.type',$rid,
                    679: 		 $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.66      www       680: # cascade down manually
1.182     albertel  681:     my $cascadetype=$$defaulttype{$which};
1.269     raeburn   682:     for (my $i=14;$i>0;$i--) {
1.66      www       683: 	 if ($typeoutpar[$i]) { 
                    684:             $cascadetype=$typeoutpar[$i];
                    685: 	} else {
                    686:             $typeoutpar[$i]=$cascadetype;
                    687:         }
                    688:     }
1.57      albertel  689:     my $parm=$$display{$which};
                    690: 
1.203     www       691:     if ($parmlev eq 'full') {
1.57      albertel  692:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                    693:                   .$$part{$which}.'</td>');
                    694:     } else {    
                    695:         $parm=~s|\[.*\]\s||g;
                    696:     }
1.231     www       697:     my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
                    698:     if ($automatic) {
                    699: 	$parm.='<font color="red"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</font>';
                    700:     }
1.159     albertel  701:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57      albertel  702:    
1.44      albertel  703:     my $thismarker=$which;
                    704:     $thismarker=~s/^parameter\_//;
                    705:     my $mprefix=$rid.'&'.$thismarker.'&';
1.275     raeburn   706:     my $effective_parm = &valout($outpar[$result],$typeoutpar[$result]);
                    707:     my ($othergrp,$grp_parm,$controlgrp);
1.44      albertel  708: 
1.57      albertel  709:     if ($parmlev eq 'general') {
                    710: 
                    711:         if ($uname) {
1.66      www       712:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.269     raeburn   713:         } elsif ($cgroup) {
                    714:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  715:         } elsif ($csec) {
1.269     raeburn   716:             &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  717:         } else {
1.269     raeburn   718:             &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  719:         }
                    720:     } elsif ($parmlev eq 'map') {
                    721: 
                    722:         if ($uname) {
1.66      www       723:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.269     raeburn   724:         } elsif ($cgroup) {
                    725:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  726:         } elsif ($csec) {
1.269     raeburn   727:             &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  728:         } else {
1.269     raeburn   729:             &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  730:         }
                    731:     } else {
1.275     raeburn   732:         if ($uname) {
                    733:             if (@{$usersgroups} > 1) {
                    734:                 my ($coursereply,$grp_parm,$controlgrp);
                    735:                 ($coursereply,$othergrp,$grp_parm,$controlgrp) =
                    736:                     &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
                    737:                        $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
                    738:                 if ($coursereply && $result > 3) {
                    739:                     if (defined($controlgrp)) {
                    740:                         if ($cgroup ne $controlgrp) {
                    741:                             $effective_parm = $grp_parm;
                    742:                             $result = 0;
                    743:                         }
                    744:                     }
                    745:                 }
                    746:             }
                    747:         }
1.57      albertel  748: 
1.269     raeburn   749:         &print_td($r,14,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  750: 
1.269     raeburn   751: 	&print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    752: 	&print_td($r,12,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    753: 	&print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.203     www       754: 	&print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    755: 	
                    756: 	if ($csec) {
1.269     raeburn   757: 	    &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    758: 	    &print_td($r,8,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    759: 	    &print_td($r,7,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.203     www       760: 	}
1.269     raeburn   761: 
                    762:         if ($cgroup) {
                    763:             &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    764:             &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    765:             &print_td($r,4,$defbgthree,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    766:         }
1.275     raeburn   767:      
1.203     www       768: 	if ($uname) {
1.275     raeburn   769:             if ($othergrp) {
                    770:                 $r->print($othergrp);
                    771:             }
1.203     www       772: 	    &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    773: 	    &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    774: 	    &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    775: 	}
1.57      albertel  776: 
                    777:     } # end of $parmlev if/else
1.275     raeburn   778:     $r->print('<td bgcolor="#CCCCFF" align="center">'.$effective_parm.'</td>');
1.136     albertel  779: 
1.203     www       780:     if ($parmlev eq 'full') {
1.136     albertel  781:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201     www       782:                                         '.'.$$name{$which},$$symbp{$rid});
1.136     albertel  783:         my $sessionvaltype=$typeoutpar[$result];
                    784:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
1.275     raeburn   785:         $r->print('<td bgcolor="#999999" align="center"><font color="#FFFFFF">'.
1.66      www       786:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel  787:                   '</font></td>');
1.136     albertel  788:     }
1.44      albertel  789:     $r->print('</tr>');
1.57      albertel  790:     $r->print("\n");
1.44      albertel  791: }
1.59      matthew   792: 
1.44      albertel  793: sub print_td {
1.66      www       794:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57      albertel  795:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114     www       796:               ' align="center">');
1.269     raeburn   797:     if ($which<11 || $which > 12) {
1.114     www       798: 	$r->print(&plink($$typeoutpar[$which],
                    799: 			 $$display{$value},$$outpar[$which],
                    800: 			 $mprefix."$which",'parmform.pres','psub'));
                    801:     } else {
                    802: 	$r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
                    803:     }
                    804:     $r->print('</td>'."\n");
1.57      albertel  805: }
                    806: 
1.275     raeburn   807: sub print_usergroups {
                    808:     my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
                    809:     my $courseid = $env{'request.course.id'};
                    810:     my $output;
                    811:     my $symb = &symbcache($rid);
                    812:     my $symbparm=$symb.'.'.$what;
                    813:     my $map=(&Apache::lonnet::decode_symb($symb))[0];
                    814:     my $mapparm=$map.'___(all).'.$what;
                    815:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
                    816:           &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,$what,
                    817:                                                                    $courseopt);
                    818:     my $bgcolor = $defbg;
                    819:     my $grp_parm;
                    820:     if (($coursereply) && ($cgroup ne $resultgroup)) { 
                    821:         if ($result > 3) {
                    822:             $bgcolor = '"#AAFFAA"';
                    823:             $grp_parm = &valout($coursereply,$resulttype);
                    824:         }
                    825:         $grp_parm = &valout($coursereply,$resulttype);
                    826:         $output = '<td bgcolor='.$bgcolor.' align="center">';
                    827:         if ($resultgroup && $resultlevel) {
                    828:             $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
                    829:         } else {
                    830:             $output .= '&nbsp;';
                    831:         }
                    832:         $output .= '</td>';
                    833:     } else {
                    834:         $output .= '<td bgcolor='.$bgcolor.'>&nbsp;</td>';
                    835:     }
                    836:     return ($coursereply,$output,$grp_parm,$resultgroup);
                    837: }
                    838: 
                    839: sub parm_control_group {
                    840:     my ($courseid,$usersgroups,$symbparm,$mapparm,$what,$courseopt) = @_;
                    841:     my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                    842:     my $grpfound = 0;
                    843:     my @levels = ($symbparm,$mapparm,$what);
                    844:     my @levelnames = ('resource','map/folder','general');
                    845:     foreach my $group (@{$usersgroups}) {
                    846:         if ($grpfound) { last; }
                    847:         for (my $i=0; $i<@levels; $i++) {
                    848:             my $item = $courseid.'.['.$group.'].'.$levels[$i];
                    849:             if (defined($$courseopt{$item})) {
                    850:                 $coursereply = $$courseopt{$item};
                    851:                 $resultitem = $item;
                    852:                 $resultgroup = $group;
                    853:                 $resultlevel = $levelnames[$i];
                    854:                 $resulttype = $$courseopt{$item.'.type'};
                    855:                 $grpfound = 1;
                    856:                 last;
                    857:             }
                    858:         }
                    859:     }
                    860:     return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
                    861: }
1.201     www       862: 
1.63      bowersj2  863: =pod
                    864: 
                    865: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
                    866: 
                    867: Input: See list below:
                    868: 
                    869: =over 4
                    870: 
                    871: =item B<ids>: An array that will contain all of the ids in the course.
                    872: 
                    873: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
                    874: 
1.171     www       875: =item B<keyp>: hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.63      bowersj2  876: 
                    877: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
                    878: 
                    879: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    880: 
                    881: =item B<allkeys>: hash, full key to part->display value (what's display value?)
                    882: 
                    883: =item B<allmaps>: hash, ???
                    884: 
                    885: =item B<fcat>: ???
                    886: 
                    887: =item B<defp>: hash, ???
                    888: 
                    889: =item B<mapp>: ??
                    890: 
                    891: =item B<symbp>: hash, id->full sym?
                    892: 
                    893: =back
                    894: 
                    895: =cut
                    896: 
                    897: sub extractResourceInformation {
                    898:     my $ids = shift;
                    899:     my $typep = shift;
                    900:     my $keyp = shift;
                    901:     my $allparms = shift;
                    902:     my $allparts = shift;
                    903:     my $allmaps = shift;
                    904:     my $mapp = shift;
                    905:     my $symbp = shift;
1.82      www       906:     my $maptitles=shift;
1.196     www       907:     my $uris=shift;
1.210     www       908:     my $keyorder=shift;
1.211     www       909:     my $defkeytype=shift;
1.196     www       910: 
1.210     www       911:     my $keyordercnt=100;
1.63      bowersj2  912: 
1.196     www       913:     my $navmap = Apache::lonnavmaps::navmap->new();
                    914:     my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
                    915:     foreach my $resource (@allres) {
                    916: 	my $id=$resource->id();
                    917:         my ($mapid,$resid)=split(/\./,$id);
                    918: 	if ($mapid eq '0') { next; }
                    919: 	$$ids[$#$ids+1]=$id;
                    920: 	my $srcf=$resource->src();
                    921: 	$srcf=~/\.(\w+)$/;
                    922: 	$$typep{$id}=$1;
                    923: 	$$keyp{$id}='';
                    924:         $$uris{$id}=$srcf;
                    925: 	foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                    926: 	    if ($_=~/^parameter\_(.*)/) {
                    927: 		my $key=$_;
1.209     www       928: # Hidden parameters
                    929: 		if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm') {
                    930: 		    next;
1.63      bowersj2  931: 		}
1.196     www       932: 		my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                    933: 		my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                    934: 		my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
1.209     www       935: #
                    936: # allparms is a hash of parameter names
                    937: #
1.196     www       938: 		my $parmdis = $display;
1.209     www       939: 		$parmdis =~ s/\[Part.*$//g;
                    940:                 $$allparms{$name}=$parmdis;
1.211     www       941: 		$$defkeytype{$name}=&Apache::lonnet::metadata($srcf,$key.'.type');
1.209     www       942: #
                    943: # allparts is a hash of all parts
                    944: #
                    945: 		$$allparts{$part} = "Part: $part";
                    946: #
                    947: # Remember all keys going with this resource
                    948: #
1.196     www       949: 		if ($$keyp{$id}) {
                    950: 		    $$keyp{$id}.=','.$key;
1.175     albertel  951: 		} else {
1.196     www       952: 		    $$keyp{$id}=$key;
1.175     albertel  953: 		}
1.210     www       954: #
                    955: # Put in order
                    956: # 
                    957:                 unless ($$keyorder{$key}) {
                    958:                     $$keyorder{$key}=$keyordercnt;
                    959:                     $keyordercnt++;
                    960: 		}
                    961: 
1.63      bowersj2  962: 	    }
                    963: 	}
1.196     www       964: 	$$mapp{$id}=
                    965: 	    &Apache::lonnet::declutter($resource->enclosing_map_src());
                    966: 	$$mapp{$mapid}=$$mapp{$id};
                    967: 	$$allmaps{$mapid}=$$mapp{$id};
                    968: 	if ($mapid eq '1') {
                    969: 	    $$maptitles{$mapid}='Main Course Documents';
                    970: 	} else {
                    971: 	    $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
                    972: 	}
                    973: 	$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
                    974: 	$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
                    975: 	$$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.63      bowersj2  976:     }
                    977: }
                    978: 
1.208     www       979: 
                    980: ##################################################
                    981: ##################################################
                    982: 
1.213     www       983: sub isdateparm {
                    984:     my $type=shift;
                    985:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                    986: }
                    987: 
1.208     www       988: sub parmmenu {
1.211     www       989:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.208     www       990:     my $tempkey;
                    991:     $r->print(<<ENDSCRIPT);
                    992: <script type="text/javascript">
                    993:     function checkall(value, checkName) {
                    994: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                    995:             ele = document.forms.parmform.elements[i];
                    996:             if (ele.name == checkName) {
                    997:                 document.forms.parmform.elements[i].checked=value;
                    998:             }
                    999:         }
                   1000:     }
1.210     www      1001: 
                   1002:     function checkthis(thisvalue, checkName) {
                   1003: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                   1004:             ele = document.forms.parmform.elements[i];
                   1005:             if (ele.name == checkName) {
                   1006: 		if (ele.value == thisvalue) {
                   1007: 		    document.forms.parmform.elements[i].checked=true;
                   1008: 		}
                   1009:             }
                   1010:         }
                   1011:     }
                   1012: 
                   1013:     function checkdates() {
                   1014: 	checkthis('duedate','pscat');
                   1015:  	checkthis('opendate','pscat');
                   1016: 	checkthis('answerdate','pscat');
1.218     www      1017:     }
                   1018: 
                   1019:     function checkdisset() {
                   1020: 	checkthis('discussend','pscat');
                   1021:  	checkthis('discusshide','pscat');
                   1022:     }
                   1023: 
                   1024:     function checkcontdates() {
                   1025: 	checkthis('contentopen','pscat');
                   1026:  	checkthis('contentclose','pscat');
                   1027:     }
                   1028:  
1.210     www      1029: 
                   1030:     function checkvisi() {
                   1031: 	checkthis('hiddenresource','pscat');
                   1032:  	checkthis('encrypturl','pscat');
                   1033: 	checkthis('problemstatus','pscat');
                   1034: 	checkthis('contentopen','pscat');
                   1035: 	checkthis('opendate','pscat');
                   1036:     }
                   1037: 
                   1038:     function checkparts() {
                   1039: 	checkthis('hiddenparts','pscat');
                   1040: 	checkthis('display','pscat');
                   1041: 	checkthis('ordered','pscat');
                   1042:     }
                   1043: 
                   1044:     function checkstandard() {
                   1045:         checkall(false,'pscat');
                   1046: 	checkdates();
                   1047: 	checkthis('weight','pscat');
                   1048: 	checkthis('maxtries','pscat');
                   1049:     }
                   1050: 
1.208     www      1051: </script>
                   1052: ENDSCRIPT
1.209     www      1053:     $r->print();
1.208     www      1054:     $r->print("\n<table><tr>");
                   1055:     my $cnt=0;
1.211     www      1056:     foreach $tempkey (&keysindisplayorder($allparms,$keyorder)) {
1.235     albertel 1057: 	$r->print("\n<td><font size='-1'><label><input type='checkbox' name='pscat' ");
1.208     www      1058: 	$r->print('value="'.$tempkey.'"');
                   1059: 	if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   1060: 	    $r->print(' checked');
                   1061: 	}
1.235     albertel 1062: 	$r->print('>'.$$allparms{$tempkey}.'</label></font></td>');
1.209     www      1063:  	$cnt++;
                   1064:         if ($cnt==3) {
                   1065: 	    $r->print("</tr>\n<tr>");
                   1066: 	    $cnt=0;
                   1067: 	}
1.208     www      1068:     }
                   1069:     $r->print('
                   1070: </tr><tr><td>
1.233     albertel 1071: <a href="javascript:checkall(true, \'pscat\')">Select&nbsp;All</a><br />
                   1072: <a href="javascript:checkstandard()">Select&nbsp;Common&nbsp;Only</a>
1.210     www      1073: </td><td>
1.233     albertel 1074: <a href="javascript:checkdates()">Add&nbsp;Problem&nbsp;Dates</a>
                   1075: <a href="javascript:checkcontdates()">Add&nbsp;Content&nbsp;Dates</a><br />
                   1076: <a href="javascript:checkdisset()">Add&nbsp;Discussion&nbsp;Settings</a>
                   1077: <a href="javascript:checkvisi()">Add&nbsp;Visibilities</a><br />
                   1078: <a href="javascript:checkparts()">Add&nbsp;Part&nbsp;Parameters</a>
1.210     www      1079: </td><td>
1.233     albertel 1080: <a href="javascript:checkall(false, \'pscat\')">Unselect&nbsp;All</a>
1.208     www      1081: </td>
                   1082: ');
                   1083:     $r->print('</tr></table>');
                   1084: }
                   1085: 
1.209     www      1086: sub partmenu {
                   1087:     my ($r,$allparts,$psprt)=@_;
1.211     www      1088:     $r->print('<select multiple name="psprt" size="8">');
1.208     www      1089:     $r->print('<option value="all"');
                   1090:     $r->print(' selected') unless (@{$psprt});
                   1091:     $r->print('>'.&mt('All Parts').'</option>');
                   1092:     my %temphash=();
                   1093:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 1094:     foreach my $tempkey (sort {
                   1095: 	if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   1096:     } keys(%{$allparts})) {
1.208     www      1097: 	unless ($tempkey =~ /\./) {
                   1098: 	    $r->print('<option value="'.$tempkey.'"');
                   1099: 	    if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   1100: 		$r->print(' selected');
                   1101: 	    }
                   1102: 	    $r->print('>'.$$allparts{$tempkey}.'</option>');
                   1103: 	}
                   1104:     }
1.209     www      1105:     $r->print('</select>');
                   1106: }
                   1107: 
                   1108: sub usermenu {
1.275     raeburn  1109:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups)=@_;
1.209     www      1110:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   1111:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   1112:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
                   1113:     my %lt=&Apache::lonlocal::texthash(
1.269     raeburn  1114: 		    'se'    => "Section",
                   1115:                     'gr'    => "Group",
1.209     www      1116: 		    'fu'    => "For User",
                   1117: 		    'oi'    => "or ID",
                   1118: 		    'ad'    => "at Domain"
                   1119: 				       );
                   1120:     my $sections='';
1.300   ! albertel 1121:     my %sectionhash = &Apache::loncommon::get_sections();
        !          1122: 
1.269     raeburn  1123:     my $groups;
1.299     albertel 1124:     my %grouphash = &Apache::loncommon::coursegroups();
                   1125: 
1.300   ! albertel 1126:     if (%sectionhash) {
1.269     raeburn  1127:         $sections=$lt{'se'}.': <select name="csec"';
1.299     albertel 1128:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  1129:             $sections .= qq| onchange="group_or_section('csec')" |;
                   1130:         }
                   1131:         $sections .= '>';
1.275     raeburn  1132: 	foreach my $section ('',sort keys %sectionhash) {
                   1133: 	    $sections.='<option value="'.$section.'" '.
                   1134: 		($section eq $csec?'selected="selected"':'').'>'.$section.
                   1135:                                                               '</option>';
1.209     www      1136:         }
                   1137:         $sections.='</select>';
1.269     raeburn  1138:     }
1.300   ! albertel 1139:     if (%sectionhash && %grouphash && $parmlev ne 'full') {
1.269     raeburn  1140:         $sections .= '&nbsp;or&nbsp;';
                   1141:         $sections .= qq|
                   1142: <script type="text/javascript">
                   1143: function group_or_section(caller) {
                   1144:    if (caller == "cgroup") {
                   1145:        if (document.parmform.cgroup.selectedIndex != 0) {
                   1146:            document.parmform.csec.selectedIndex = 0;
                   1147:        }
                   1148:    } else {
                   1149:        if (document.parmform.csec.selectedIndex != 0) {
                   1150:            document.parmform.cgroup.selectedIndex = 0;
                   1151:        }
                   1152:    }
                   1153: }
                   1154: </script>
                   1155: |;
                   1156:     } else {
                   1157:         $sections .= qq|
                   1158: <script type="text/javascript">
                   1159: function group_or_section(caller) {
                   1160:     return;
                   1161: }
                   1162: </script>
                   1163: |;
                   1164:     } 
1.299     albertel 1165: 
                   1166:     if (%grouphash) {
1.269     raeburn  1167:         $groups=$lt{'gr'}.': <select name="cgroup"';
1.300   ! albertel 1168:         if (%sectionhash && $env{'form.action'} eq 'settable') {
1.269     raeburn  1169:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   1170:         }
                   1171:         $groups .= '>';
1.275     raeburn  1172:         foreach my $grp ('',sort keys %grouphash) {
                   1173:             $groups.='<option value="'.$grp.'" ';
                   1174:             if ($grp eq $cgroup) {
                   1175:                 unless ((defined($uname)) && ($grp eq '')) {
                   1176:                     $groups .=  'selected="selected" ';
                   1177:                 }
                   1178:             } elsif (!defined($cgroup)) {
                   1179:                 if (@{$usersgroups} == 1) {
                   1180:                     if ($grp eq $$usersgroups[0]) {
                   1181:                         $groups .=  'selected="selected" ';
                   1182:                     }
                   1183:                 }
                   1184:             }
                   1185:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  1186:         }
                   1187:         $groups.='</select>';
                   1188:     }
                   1189:     $r->print(<<ENDMENU);
1.209     www      1190: <b>
                   1191: $sections
1.269     raeburn  1192: $groups
1.209     www      1193: <br />
                   1194: $lt{'fu'} 
                   1195: <input type="text" value="$uname" size="12" name="uname" />
                   1196: $lt{'oi'}
                   1197: <input type="text" value="$id" size="12" name="id" /> 
                   1198: $lt{'ad'}
                   1199: $chooseopt
                   1200: </b>
                   1201: ENDMENU
                   1202: }
                   1203: 
                   1204: sub displaymenu {
1.211     www      1205:     my ($r,$allparms,$allparts,$pscat,$psprt,$keyorder)=@_;
1.209     www      1206:     $r->print('<table border="1"><tr><th>'.&mt('Select Parameters to View').'</th><th>'.
                   1207: 	     &mt('Select Parts to View').'</th></tr><tr><td>');  
1.211     www      1208:     &parmmenu($r,$allparms,$pscat,$keyorder);
1.209     www      1209:     $r->print('</td><td>');
                   1210:     &partmenu($r,$allparts,$psprt);
                   1211:     $r->print('</td></tr></table>');
                   1212: }
                   1213: 
                   1214: sub mapmenu {
                   1215:     my ($r,$allmaps,$pschp,$maptitles)=@_;
1.231     www      1216:     $r->print('<b>'.&mt('Select Enclosing Map or Folder').'</b> ');
1.209     www      1217:     $r->print('<select name="pschp">');
                   1218:     $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
                   1219:     foreach (sort {$$allmaps{$a} cmp $$allmaps{$b}} keys %{$allmaps}) {
1.208     www      1220: 	$r->print('<option value="'.$_.'"');
1.209     www      1221: 	if (($pschp eq $_)) { $r->print(' selected'); }
                   1222: 	$r->print('>'.$$maptitles{$_}.($$allmaps{$_}!~/^uploaded/?' ['.$$allmaps{$_}.']':'').'</option>');
                   1223:     }
                   1224:     $r->print("</select>");
                   1225: }
                   1226: 
                   1227: sub levelmenu {
                   1228:     my ($r,$alllevs,$parmlev)=@_;
1.231     www      1229:     $r->print('<b>'.&mt('Select Parameter Level').
                   1230: 	      &Apache::loncommon::help_open_topic('Course_Parameter_Levels').'</b> ');
1.209     www      1231:     $r->print('<select name="parmlev">');
                   1232:     foreach (reverse sort keys %{$alllevs}) {
                   1233: 	$r->print('<option value="'.$$alllevs{$_}.'"');
                   1234: 	if ($parmlev eq $$alllevs{$_}) {
                   1235: 	    $r->print(' selected'); 
                   1236: 	}
                   1237: 	$r->print('>'.$_.'</option>');
1.208     www      1238:     }
1.209     www      1239:     $r->print("</select>");
1.208     www      1240: }
                   1241: 
1.211     www      1242: 
                   1243: sub sectionmenu {
                   1244:     my ($r,$selectedsections)=@_;
1.300   ! albertel 1245:     my %sectionhash = &Apache::loncommon::get_sections();
        !          1246:     return if (!%sectionhash);
        !          1247: 
        !          1248:     $r->print('<select name="Section" multiple="true" size="8" >');
        !          1249:     foreach my $s ('all',sort keys %sectionhash) {
        !          1250: 	$r->print('    <option value="'.$s.'"');
        !          1251: 	foreach (@{$selectedsections}) {
        !          1252: 	    if ($s eq $_) {
        !          1253: 		$r->print(' selected');
        !          1254: 		last;
1.212     www      1255: 	    }
                   1256: 	}
1.300   ! albertel 1257: 	$r->print('>'.$s."</option>\n");
        !          1258:     }
        !          1259:     $r->print("</select>\n");
1.269     raeburn  1260: }
                   1261: 
                   1262: sub groupmenu {
                   1263:     my ($r,$selectedgroups)=@_;
1.299     albertel 1264:     my %grouphash = &Apache::loncommon::coursegroups();
                   1265:     return if (!%grouphash);
                   1266: 
                   1267:     $r->print('<select name="Group" multiple="true" size="8" >');
                   1268:     foreach my $group (sort(keys(%grouphash))) {
                   1269: 	$r->print('    <option value="'.$group.'"');
                   1270: 	foreach (@{$selectedgroups}) {
                   1271: 	    if ($group eq $_) {
                   1272: 		$r->print(' selected');
                   1273: 		last;
                   1274: 	    }
                   1275: 	}
                   1276: 	$r->print('>'.$group."</option>\n");
1.211     www      1277:     }
1.299     albertel 1278:     $r->print("</select>\n");
1.211     www      1279: }
                   1280: 
1.269     raeburn  1281: 
1.210     www      1282: sub keysplit {
                   1283:     my $keyp=shift;
                   1284:     return (split(/\,/,$keyp));
                   1285: }
                   1286: 
                   1287: sub keysinorder {
                   1288:     my ($name,$keyorder)=@_;
                   1289:     return sort {
                   1290: 	$$keyorder{$a} <=> $$keyorder{$b};
                   1291:     } (keys %{$name});
                   1292: }
                   1293: 
1.236     albertel 1294: sub keysinorder_bytype {
                   1295:     my ($name,$keyorder)=@_;
                   1296:     return sort {
                   1297: 	my $ta=(split('_',$a))[-1];
                   1298: 	my $tb=(split('_',$b))[-1];
                   1299: 	if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   1300: 	    return ($a cmp $b);
                   1301: 	}
                   1302: 	$$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
                   1303:     } (keys %{$name});
                   1304: }
                   1305: 
1.211     www      1306: sub keysindisplayorder {
                   1307:     my ($name,$keyorder)=@_;
                   1308:     return sort {
                   1309: 	$$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
                   1310:     } (keys %{$name});
                   1311: }
                   1312: 
1.214     www      1313: sub sortmenu {
                   1314:     my ($r,$sortorder)=@_;
1.236     albertel 1315:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      1316:     if ($sortorder eq 'realmstudent') {
                   1317:        $r->print(' checked="on"');
                   1318:     }
                   1319:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 1320:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      1321:     if ($sortorder eq 'studentrealm') {
                   1322:        $r->print(' checked="on"');
                   1323:     }
1.236     albertel 1324:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
                   1325: 	      '</label>');
1.214     www      1326: }
                   1327: 
1.211     www      1328: sub standardkeyorder {
                   1329:     return ('parameter_0_opendate' => 1,
                   1330: 	    'parameter_0_duedate' => 2,
                   1331: 	    'parameter_0_answerdate' => 3,
                   1332: 	    'parameter_0_interval' => 4,
                   1333: 	    'parameter_0_weight' => 5,
                   1334: 	    'parameter_0_maxtries' => 6,
                   1335: 	    'parameter_0_hinttries' => 7,
                   1336: 	    'parameter_0_contentopen' => 8,
                   1337: 	    'parameter_0_contentclose' => 9,
                   1338: 	    'parameter_0_type' => 10,
                   1339: 	    'parameter_0_problemstatus' => 11,
                   1340: 	    'parameter_0_hiddenresource' => 12,
                   1341: 	    'parameter_0_hiddenparts' => 13,
                   1342: 	    'parameter_0_display' => 14,
                   1343: 	    'parameter_0_ordered' => 15,
                   1344: 	    'parameter_0_tol' => 16,
                   1345: 	    'parameter_0_sig' => 17,
1.218     www      1346: 	    'parameter_0_turnoffunit' => 18,
                   1347:             'parameter_0_discussend' => 19,
                   1348:             'parameter_0_discusshide' => 20);
1.211     www      1349: }
                   1350: 
1.59      matthew  1351: ##################################################
                   1352: ##################################################
                   1353: 
                   1354: =pod
                   1355: 
                   1356: =item assessparms
                   1357: 
                   1358: Show assessment data and parameters.  This is a large routine that should
                   1359: be simplified and shortened... someday.
                   1360: 
                   1361: Inputs: $r
                   1362: 
                   1363: Returns: nothing
                   1364: 
1.63      bowersj2 1365: Variables used (guessed by Jeremy):
                   1366: 
                   1367: =over 4
                   1368: 
                   1369: =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.
                   1370: 
                   1371: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                   1372: 
                   1373: =item B<allmaps>:
                   1374: 
                   1375: =back
                   1376: 
1.59      matthew  1377: =cut
                   1378: 
                   1379: ##################################################
                   1380: ##################################################
1.30      www      1381: sub assessparms {
1.1       www      1382: 
1.43      albertel 1383:     my $r=shift;
1.201     www      1384: 
                   1385:     my @ids=();
                   1386:     my %symbp=();
                   1387:     my %mapp=();
                   1388:     my %typep=();
                   1389:     my %keyp=();
                   1390:     my %uris=();
                   1391:     my %maptitles=();
                   1392: 
1.2       www      1393: # -------------------------------------------------------- Variable declaration
1.209     www      1394: 
1.129     www      1395:     my %allmaps=();
                   1396:     my %alllevs=();
1.57      albertel 1397: 
1.187     www      1398:     my $uname;
                   1399:     my $udom;
                   1400:     my $uhome;
                   1401:     my $csec;
1.269     raeburn  1402:     my $cgroup;
1.275     raeburn  1403:     my @usersgroups = ();
1.187     www      1404:  
1.190     albertel 1405:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      1406: 
1.57      albertel 1407:     $alllevs{'Resource Level'}='full';
1.215     www      1408:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 1409:     $alllevs{'Course Level'}='general';
                   1410: 
                   1411:     my %allparms;
                   1412:     my %allparts;
1.210     www      1413: #
                   1414: # Order in which these parameters will be displayed
                   1415: #
1.211     www      1416:     my %keyorder=&standardkeyorder();
                   1417: 
1.43      albertel 1418:     @ids=();
                   1419:     %symbp=();
                   1420:     %typep=();
                   1421: 
                   1422:     my $message='';
                   1423: 
1.190     albertel 1424:     $csec=$env{'form.csec'};
1.269     raeburn  1425:     $cgroup=$env{'form.cgroup'};
1.188     www      1426: 
1.190     albertel 1427:     if      ($udom=$env{'form.udom'}) {
                   1428:     } elsif ($udom=$env{'request.role.domain'}) {
                   1429:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 1430:     } else {
                   1431: 	$udom=$r->dir_config('lonDefDomain');
                   1432:     }
1.43      albertel 1433: 
1.134     albertel 1434:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 1435:     my $pschp=$env{'form.pschp'};
1.134     albertel 1436:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76      www      1437:     if (!@psprt) { $psprt[0]='0'; }
1.57      albertel 1438: 
1.43      albertel 1439:     my $pssymb='';
1.57      albertel 1440:     my $parmlev='';
                   1441:  
1.190     albertel 1442:     unless ($env{'form.parmlev'}) {
1.57      albertel 1443:         $parmlev = 'map';
                   1444:     } else {
1.190     albertel 1445:         $parmlev = $env{'form.parmlev'};
1.57      albertel 1446:     }
1.26      www      1447: 
1.29      www      1448: # ----------------------------------------------- Was this started from grades?
                   1449: 
1.190     albertel 1450:     if (($env{'form.command'} eq 'set') && ($env{'form.url'})
                   1451: 	&& (!$env{'form.dis'})) {
                   1452: 	my $url=$env{'form.url'};
1.194     albertel 1453: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.43      albertel 1454: 	$pssymb=&Apache::lonnet::symbread($url);
1.92      albertel 1455: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1456: 	$pschp='';
1.57      albertel 1457:         $parmlev = 'full';
1.190     albertel 1458:     } elsif ($env{'form.symb'}) {
                   1459: 	$pssymb=$env{'form.symb'};
1.92      albertel 1460: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel 1461: 	$pschp='';
1.57      albertel 1462:         $parmlev = 'full';
1.43      albertel 1463:     } else {
1.190     albertel 1464: 	$env{'form.url'}='';
1.43      albertel 1465:     }
                   1466: 
1.190     albertel 1467:     my $id=$env{'form.id'};
1.43      albertel 1468:     if (($id) && ($udom)) {
                   1469: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                   1470: 	if ($uname) {
                   1471: 	    $id='';
                   1472: 	} else {
                   1473: 	    $message=
1.133     www      1474: 		"<font color=red>".&mt("Unknown ID")." '$id' ".
                   1475: 		&mt('at domain')." '$udom'</font>";
1.43      albertel 1476: 	}
                   1477:     } else {
1.190     albertel 1478: 	$uname=$env{'form.uname'};
1.43      albertel 1479:     }
                   1480:     unless ($udom) { $uname=''; }
                   1481:     $uhome='';
                   1482:     if ($uname) {
                   1483: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                   1484:         if ($uhome eq 'no_host') {
                   1485: 	    $message=
1.133     www      1486: 		"<font color=red>".&mt("Unknown user")." '$uname' ".
                   1487: 		&mt("at domain")." '$udom'</font>";
1.43      albertel 1488: 	    $uname='';
1.12      www      1489:         } else {
1.103     albertel 1490: 	    $csec=&Apache::lonnet::getsection($udom,$uname,
1.190     albertel 1491: 					      $env{'request.course.id'});
1.269     raeburn  1492:             
1.43      albertel 1493: 	    if ($csec eq '-1') {
                   1494: 		$message="<font color=red>".
1.133     www      1495: 		    &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                   1496: 		    &mt("not in this course")."</font>";
1.43      albertel 1497: 		$uname='';
1.190     albertel 1498: 		$csec=$env{'form.csec'};
1.269     raeburn  1499:                 $cgroup=$env{'form.cgroup'};
1.43      albertel 1500: 	    } else {
                   1501: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1502: 		      ('firstname','middlename','lastname','generation','id'));
1.133     www      1503: 		$message="\n<p>\n".&mt("Full Name").": ".
1.43      albertel 1504: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                   1505: 			.$name{'lastname'}.' '.$name{'generation'}.
1.133     www      1506: 			    "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43      albertel 1507: 	    }
1.297     raeburn  1508:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  1509:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  1510:             if (@usersgroups > 0) {
1.275     raeburn  1511:                 unless (grep/^\Q$cgroup\E$/,@usersgroups) {
                   1512:                     $cgroup = $usersgroups[0];
1.297     raeburn  1513:                 }
1.269     raeburn  1514:             }
1.12      www      1515:         }
1.43      albertel 1516:     }
1.2       www      1517: 
1.43      albertel 1518:     unless ($csec) { $csec=''; }
1.269     raeburn  1519:     unless ($cgroup) { $cgroup=''; }
1.12      www      1520: 
1.14      www      1521: # --------------------------------------------------------- Get all assessments
1.210     www      1522:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   1523: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   1524: 				\%keyorder);
1.63      bowersj2 1525: 
1.57      albertel 1526:     $mapp{'0.0'} = '';
                   1527:     $symbp{'0.0'} = '';
1.99      albertel 1528: 
1.14      www      1529: # ---------------------------------------------------------- Anything to store?
1.190     albertel 1530:     if ($env{'form.pres_marker'}) {
1.205     www      1531:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   1532:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   1533:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
                   1534: 	for (my $i=0;$i<=$#markers;$i++) {
                   1535: 	    $message.=&storeparm(split(/\&/,$markers[$i]),
                   1536: 				 $values[$i],
                   1537: 				 $types[$i],
1.269     raeburn  1538: 				 $uname,$udom,$csec,$cgroup);
1.205     www      1539: 	}
1.68      www      1540: # ---------------------------------------------------------------- Done storing
1.130     www      1541: 	$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      1542:     }
1.57      albertel 1543: #----------------------------------------------- if all selected, fill in array
1.209     www      1544:     if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
                   1545:     if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries') }; 
1.57      albertel 1546:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www      1547: # ------------------------------------------------------------------ Start page
1.63      bowersj2 1548: 
1.209     www      1549:     &startpage($r);
1.57      albertel 1550: 
1.44      albertel 1551:     foreach ('tolerance','date_default','date_start','date_end',
                   1552: 	     'date_interval','int','float','string') {
                   1553: 	$r->print('<input type="hidden" value="'.
1.190     albertel 1554: 		  $env{'form.recent_'.$_}.'" name="recent_'.$_.'">');
1.44      albertel 1555:     }
1.57      albertel 1556:                         
1.44      albertel 1557:     if (!$pssymb) {
1.209     www      1558:         $r->print('<table border="1"><tr><td>');
                   1559:         &levelmenu($r,\%alllevs,$parmlev);
1.128     albertel 1560: 	if ($parmlev ne 'general') {
1.209     www      1561:             $r->print('<td>');
                   1562: 	    &mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   1563: 	    $r->print('</td>');
1.128     albertel 1564: 	}
1.209     www      1565:         $r->print('</td></tr></table>');
1.211     www      1566: 	&displaymenu($r,\%allparms,\%allparts,\@pscat,\@psprt,\%keyorder);
1.44      albertel 1567:     } else {
1.125     www      1568:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.209     www      1569:         $r->print(&mt('Specific Resource').": ".$resource.
1.238     www      1570:                   '<input type="hidden" value="'.$pssymb.'" name="symb">'.
                   1571: 		  '<br /><label><b>'.&mt('Show all parts').': <input type="checkbox" name="psprt" value="all"'.
                   1572: 		  ($env{'form.psprt'}?' checked="checked"':'').' /></b></label><br />');
1.57      albertel 1573:     }
1.275     raeburn  1574:     &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups);    
1.57      albertel 1575: 
1.210     www      1576:     $r->print('<p>'.$message.'</p>');
                   1577: 
1.209     www      1578:     $r->print('<br /><input type="submit" name="dis" value="'.&mt("Update Parameter Display").'" />');
1.57      albertel 1579: 
                   1580:     my @temp_pscat;
                   1581:     map {
                   1582:         my $cat = $_;
                   1583:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   1584:     } @pscat;
                   1585: 
                   1586:     @pscat = @temp_pscat;
                   1587: 
1.209     www      1588:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      1589: # ----------------------------------------------------------------- Start Table
1.57      albertel 1590:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 1591:         my $csuname=$env{'user.name'};
                   1592:         my $csudom=$env{'user.domain'};
1.57      albertel 1593: 
1.203     www      1594:         if ($parmlev eq 'full') {
1.57      albertel 1595:            my $coursespan=$csec?8:5;
1.275     raeburn  1596:            my $userspan=3;
1.269     raeburn  1597:            if ($cgroup ne '') {
                   1598:               $coursespan += 3;
                   1599:            } 
                   1600:       
1.57      albertel 1601:            $r->print('<p><table border=2>');
                   1602:            $r->print('<tr><td colspan=5></td>');
1.130     www      1603:            $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57      albertel 1604:            if ($uname) {
1.275     raeburn  1605:                if (@usersgroups > 1) {
                   1606:                    $userspan ++;
                   1607:                }
                   1608:                $r->print('<th colspan="'.$userspan.'" rowspan="2">');
1.130     www      1609:                $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57      albertel 1610:            }
1.133     www      1611: 	   my %lt=&Apache::lonlocal::texthash(
                   1612: 				  'pie'    => "Parameter in Effect",
                   1613: 				  'csv'    => "Current Session Value",
                   1614:                                   'at'     => 'at',
                   1615:                                   'rl'     => "Resource Level",
                   1616: 				  'ic'     => 'in Course',
                   1617: 				  'aut'    => "Assessment URL and Title",
1.143     albertel 1618: 				  'type'   => 'Type',
1.133     www      1619: 				  'emof'   => "Enclosing Map or Folder",
1.143     albertel 1620: 				  'part'   => 'Part',
1.133     www      1621:                                   'pn'     => 'Parameter Name',
                   1622: 				  'def'    => 'default',
                   1623: 				  'femof'  => 'from Enclosing Map or Folder',
                   1624: 				  'gen'    => 'general',
                   1625: 				  'foremf' => 'for Enclosing Map or Folder',
                   1626: 				  'fr'     => 'for Resource'
                   1627: 					      );
1.57      albertel 1628:            $r->print(<<ENDTABLETWO);
1.133     www      1629: <th rowspan=3>$lt{'pie'}</th>
                   1630: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182     albertel 1631: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
                   1632: <th colspan=1>$lt{'ic'}</th>
                   1633: 
1.10      www      1634: ENDTABLETWO
1.57      albertel 1635:            if ($csec) {
1.133     www      1636:                 $r->print("<th colspan=3>".
1.269     raeburn  1637: 			  &mt("in Section")." $csec</th>");
                   1638:            }
                   1639:            if ($cgroup) {
                   1640:                 $r->print("<th colspan=3>".
                   1641:                           &mt("in Group")." $cgroup</th>");
1.57      albertel 1642:            }
                   1643:            $r->print(<<ENDTABLEHEADFOUR);
1.133     www      1644: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   1645: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192     albertel 1646: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
                   1647: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      1648: ENDTABLEHEADFOUR
1.57      albertel 1649: 
                   1650:            if ($csec) {
1.130     www      1651:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1652:            }
                   1653: 
1.269     raeburn  1654:            if ($cgroup) {
                   1655:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
                   1656:            }
                   1657: 
1.57      albertel 1658:            if ($uname) {
1.275     raeburn  1659:                if (@usersgroups > 1) {
                   1660:                    $r->print('<th>'.&mt('Control by other group?').'</th>');
                   1661:                }
1.130     www      1662:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1663:            }
                   1664: 
                   1665:            $r->print('</tr>');
                   1666: 
                   1667:            my $defbgone='';
                   1668:            my $defbgtwo='';
1.269     raeburn  1669:            my $defbgthree = '';
1.57      albertel 1670: 
                   1671:            foreach (@ids) {
                   1672: 
                   1673:                 my $rid=$_;
                   1674:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   1675: 
1.152     albertel 1676:                 if ((!$pssymb && 
                   1677: 		     (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   1678: 		    ||
                   1679: 		    ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      1680: # ------------------------------------------------------ Entry for one resource
1.184     albertel 1681:                     if ($defbgone eq '"#E0E099"') {
                   1682:                         $defbgone='"#E0E0DD"';
1.57      albertel 1683:                     } else {
1.184     albertel 1684:                         $defbgone='"#E0E099"';
1.57      albertel 1685:                     }
1.184     albertel 1686:                     if ($defbgtwo eq '"#FFFF99"') {
                   1687:                         $defbgtwo='"#FFFFDD"';
1.57      albertel 1688:                     } else {
1.184     albertel 1689:                         $defbgtwo='"#FFFF99"';
1.57      albertel 1690:                     }
1.269     raeburn  1691:                     if ($defbgthree eq '"#FFBB99"') {
                   1692:                         $defbgthree='"#FFBBDD"';
                   1693:                     } else {
                   1694:                         $defbgthree='"#FFBB99"';
                   1695:                     }
                   1696: 
1.57      albertel 1697:                     my $thistitle='';
                   1698:                     my %name=   ();
                   1699:                     undef %name;
                   1700:                     my %part=   ();
                   1701:                     my %display=();
                   1702:                     my %type=   ();
                   1703:                     my %default=();
1.196     www      1704:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1705: 
1.210     www      1706:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1707:                         my $tempkeyp = $_;
                   1708:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   1709:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   1710:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                   1711:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                   1712:                           unless ($display{$_}) { $display{$_}=''; }
                   1713:                           $display{$_}.=' ('.$name{$_}.')';
                   1714:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   1715:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   1716:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   1717:                         }
                   1718:                     }
                   1719:                     my $totalparms=scalar keys %name;
                   1720:                     if ($totalparms>0) {
                   1721:                         my $firstrow=1;
1.274     albertel 1722: 			my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.57      albertel 1723:                         $r->print('<tr><td bgcolor='.$defbgone.
                   1724:                              ' rowspan='.$totalparms.
                   1725:                              '><tt><font size=-1>'.
                   1726:                              join(' / ',split(/\//,$uri)).
                   1727:                              '</font></tt><p><b>'.
1.154     albertel 1728:                              "<a href=\"javascript:openWindow('".
1.274     albertel 1729: 				  &Apache::lonnet::clutter($uri).'?symb='.
                   1730: 				  &Apache::lonnet::escape($symbp{$rid}).
1.57      albertel 1731:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127     albertel 1732:                              " TARGET=_self>$title");
1.57      albertel 1733: 
                   1734:                         if ($thistitle) {
                   1735:                             $r->print(' ('.$thistitle.')');
                   1736:                         }
                   1737:                         $r->print('</a></b></td>');
                   1738:                         $r->print('<td bgcolor='.$defbgtwo.
                   1739:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   1740:                                       '</td>');
                   1741: 
                   1742:                         $r->print('<td bgcolor='.$defbgone.
                   1743:                                       ' rowspan='.$totalparms.
1.238     www      1744:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.57      albertel 1745: 
1.236     albertel 1746:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 1747:                             unless ($firstrow) {
                   1748:                                 $r->print('<tr>');
                   1749:                             } else {
                   1750:                                 undef $firstrow;
                   1751:                             }
1.201     www      1752:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 1753:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  1754:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.275     raeburn  1755:                                                             $cgroup,\@usersgroups);
1.57      albertel 1756:                         }
                   1757:                     }
                   1758:                 }
                   1759:             } # end foreach ids
1.43      albertel 1760: # -------------------------------------------------- End entry for one resource
1.57      albertel 1761:             $r->print('</table>');
1.203     www      1762:         } # end of  full
1.57      albertel 1763: #--------------------------------------------------- Entry for parm level map
                   1764:         if ($parmlev eq 'map') {
                   1765:             my $defbgone = '"E0E099"';
                   1766:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1767:             my $defbgthree = '"FFBB99"';
1.57      albertel 1768: 
                   1769:             my %maplist;
                   1770: 
                   1771:             if ($pschp eq 'all') {
                   1772:                 %maplist = %allmaps; 
                   1773:             } else {
                   1774:                 %maplist = ($pschp => $mapp{$pschp});
                   1775:             }
                   1776: 
                   1777: #-------------------------------------------- for each map, gather information
                   1778:             my $mapid;
1.60      albertel 1779: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   1780:                 my $maptitle = $maplist{$mapid};
1.57      albertel 1781: 
                   1782: #-----------------------  loop through ids and get all parameter types for map
                   1783: #-----------------------------------------          and associated information
                   1784:                 my %name = ();
                   1785:                 my %part = ();
                   1786:                 my %display = ();
                   1787:                 my %type = ();
                   1788:                 my %default = ();
                   1789:                 my $map = 0;
                   1790: 
                   1791: #		$r->print("Catmarker: @catmarker<br />\n");
                   1792:                
                   1793:                 foreach (@ids) {
                   1794:                   ($map)=(/([\d]*?)\./);
                   1795:                   my $rid = $_;
                   1796:         
                   1797: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   1798: 
                   1799:                   if ($map eq $mapid) {
1.196     www      1800:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1801: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   1802: 
                   1803: #--------------------------------------------------------------------
                   1804: # @catmarker contains list of all possible parameters including part #s
                   1805: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1806: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1807: # When storing information, store as part 0
                   1808: # When requesting information, request from full part
                   1809: #-------------------------------------------------------------------
1.210     www      1810:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1811:                       my $tempkeyp = $_;
                   1812:                       my $fullkeyp = $tempkeyp;
1.73      albertel 1813:                       $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1814:                       
                   1815:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1816:                         $part{$tempkeyp}="0";
                   1817:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1818:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1819:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1820:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1821:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1822:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1823:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1824:                       }
                   1825:                     } # end loop through keys
                   1826:                   }
                   1827:                 } # end loop through ids
                   1828:                                  
                   1829: #---------------------------------------------------- print header information
1.133     www      1830:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      1831:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57      albertel 1832:                 $r->print(<<ENDMAPONE);
                   1833: <center><h4>
1.135     albertel 1834: Set Defaults for All Resources in $foldermap<br />
                   1835: <font color="red"><i>$showtitle</i></font><br />
1.57      albertel 1836: Specifically for
                   1837: ENDMAPONE
                   1838:                 if ($uname) {
1.267     albertel 1839: 		    my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1840:                     $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130     www      1841:                         &mt('in')." \n");
1.57      albertel 1842:                 } else {
1.135     albertel 1843:                     $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57      albertel 1844:                 }
1.269     raeburn  1845:                 if ($cgroup) {
                   1846:                     $r->print(&mt("Group")." <font color=\"red\"><i>$cgroup".
                   1847:                               "</i></font> ".&mt('of')." \n");
                   1848:                     $csec = '';
                   1849:                 } elsif ($csec) {
                   1850:                     $r->print(&mt("Section")." <font color=\"red\"><i>$csec".
                   1851:                               "</i></font> ".&mt('of')." \n");
                   1852:                 }
1.135     albertel 1853:                 $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
                   1854:                 $r->print("</h4>\n");
1.57      albertel 1855: #---------------------------------------------------------------- print table
                   1856:                 $r->print('<p><table border="2">');
1.130     www      1857:                 $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1858:                 $r->print('<th>'.&mt('Default Value').'</th>');
                   1859:                 $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1860: 
1.210     www      1861: 	        foreach (&keysinorder(\%name,\%keyorder)) {
1.168     matthew  1862:                     $r->print('<tr>');
1.201     www      1863:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  1864:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   1865:                            $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 1866:                 }
                   1867:                 $r->print("</table></center>");
                   1868:             } # end each map
                   1869:         } # end of $parmlev eq map
                   1870: #--------------------------------- Entry for parm level general (Course level)
                   1871:         if ($parmlev eq 'general') {
                   1872:             my $defbgone = '"E0E099"';
                   1873:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1874:             my $defbgthree = '"FFBB99"';
1.57      albertel 1875: 
                   1876: #-------------------------------------------- for each map, gather information
                   1877:             my $mapid="0.0";
                   1878: #-----------------------  loop through ids and get all parameter types for map
                   1879: #-----------------------------------------          and associated information
                   1880:             my %name = ();
                   1881:             my %part = ();
                   1882:             my %display = ();
                   1883:             my %type = ();
                   1884:             my %default = ();
                   1885:                
                   1886:             foreach (@ids) {
                   1887:                 my $rid = $_;
                   1888:         
1.196     www      1889:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1890: 
                   1891: #--------------------------------------------------------------------
                   1892: # @catmarker contains list of all possible parameters including part #s
                   1893: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1894: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1895: # When storing information, store as part 0
                   1896: # When requesting information, request from full part
                   1897: #-------------------------------------------------------------------
1.210     www      1898:                 foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1899:                   my $tempkeyp = $_;
                   1900:                   my $fullkeyp = $tempkeyp;
1.73      albertel 1901:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1902:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1903:                     $part{$tempkeyp}="0";
                   1904:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1905:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1906:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1907:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1908:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1909:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1910:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1911:                   }
                   1912:                 } # end loop through keys
                   1913:             } # end loop through ids
                   1914:                                  
                   1915: #---------------------------------------------------- print header information
1.133     www      1916: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 1917:             $r->print(<<ENDMAPONE);
1.133     www      1918: <center><h4>$setdef
1.135     albertel 1919: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 1920: ENDMAPONE
                   1921:             if ($uname) {
1.267     albertel 1922: 		my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1923:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 1924:             } else {
1.135     albertel 1925:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 1926:             }
                   1927:             
1.135     albertel 1928:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.269     raeburn  1929:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.135     albertel 1930:             $r->print("</h4>\n");
1.57      albertel 1931: #---------------------------------------------------------------- print table
                   1932:             $r->print('<p><table border="2">');
1.130     www      1933:             $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1934:             $r->print('<th>'.&mt('Default Value').'</th>');
                   1935:             $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1936: 
1.210     www      1937: 	    foreach (&keysinorder(\%name,\%keyorder)) {
1.168     matthew  1938:                 $r->print('<tr>');
1.201     www      1939:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  1940:                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   1941:                                    $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 1942:             }
                   1943:             $r->print("</table></center>");
                   1944:         } # end of $parmlev eq general
1.43      albertel 1945:     }
1.280     albertel 1946:     $r->print('</form>'.&Apache::loncommon::end_page());
1.57      albertel 1947: } # end sub assessparms
1.30      www      1948: 
1.59      matthew  1949: 
                   1950: ##################################################
                   1951: ##################################################
                   1952: 
                   1953: =pod
                   1954: 
                   1955: =item crsenv
                   1956: 
1.105     matthew  1957: Show and set course data and parameters.  This is a large routine that should
1.59      matthew  1958: be simplified and shortened... someday.
                   1959: 
                   1960: Inputs: $r
                   1961: 
                   1962: Returns: nothing
                   1963: 
                   1964: =cut
                   1965: 
                   1966: ##################################################
                   1967: ##################################################
1.30      www      1968: sub crsenv {
                   1969:     my $r=shift;
                   1970:     my $setoutput='';
1.280     albertel 1971: 
1.298     albertel 1972:     my $breadcrumbs = 
                   1973: 	&Apache::lonhtmlcommon::breadcrumbs('Edit Course Environment');
1.190     albertel 1974:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1975:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.105     matthew  1976: 
                   1977:     #
                   1978:     # Go through list of changes
1.190     albertel 1979:     foreach (keys %env) {
1.105     matthew  1980:         next if ($_!~/^form\.(.+)\_setparmval$/);
                   1981:         my $name  = $1;
1.190     albertel 1982:         my $value = $env{'form.'.$name.'_value'};
1.105     matthew  1983:         if ($name eq 'newp') {
1.190     albertel 1984:             $name = $env{'form.newp_name'};
1.105     matthew  1985:         }
                   1986:         if ($name eq 'url') {
                   1987:             $value=~s/^\/res\///;
                   1988:             my $bkuptime=time;
                   1989:             my @tmp = &Apache::lonnet::get
                   1990:                 ('environment',['url'],$dom,$crs);
1.130     www      1991:             $setoutput.=&mt('Backing up previous URL').': '.
1.105     matthew  1992:                 &Apache::lonnet::put
                   1993:                 ('environment',
                   1994:                  {'top level map backup '.$bkuptime => $tmp[1] },
                   1995:                  $dom,$crs).
                   1996:                      '<br>';
                   1997:         }
                   1998:         #
                   1999:         # Deal with modified default spreadsheets
                   2000:         if ($name =~ /^spreadsheet_default_(classcalc|
                   2001:                                             studentcalc|
                   2002:                                             assesscalc)$/x) {
                   2003:             my $sheettype = $1; 
                   2004:             if ($sheettype eq 'classcalc') {
                   2005:                 # no need to do anything since viewing the sheet will
                   2006:                 # cause it to be updated. 
                   2007:             } elsif ($sheettype eq 'studentcalc') {
                   2008:                 # expire all the student spreadsheets
                   2009:                 &Apache::lonnet::expirespread('','','studentcalc');
                   2010:             } else {
                   2011:                 # expire all the assessment spreadsheets 
                   2012:                 #    this includes non-default spreadsheets, but better to
                   2013:                 #    be safe than sorry.
                   2014:                 &Apache::lonnet::expirespread('','','assesscalc');
                   2015:                 # expire all the student spreadsheets
                   2016:                 &Apache::lonnet::expirespread('','','studentcalc');
1.30      www      2017:             }
1.105     matthew  2018:         }
                   2019:         #
1.107     matthew  2020:         # Deal with the enrollment dates
                   2021:         if ($name =~ /^default_enrollment_(start|end)_date$/) {
                   2022:             $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
                   2023:         }
1.178     raeburn  2024:         # Get existing cloners
                   2025:         my @oldcloner = ();
                   2026:         if ($name eq 'cloners') {
                   2027:             my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
                   2028:             if ($clonenames{'cloners'} =~ /,/) {
                   2029:                 @oldcloner = split/,/,$clonenames{'cloners'};
                   2030:             } else {
                   2031:                 $oldcloner[0] = $clonenames{'cloners'};
                   2032:             }
                   2033:         }
1.107     matthew  2034:         #
1.105     matthew  2035:         # Let the user know we made the changes
1.153     albertel 2036:         if ($name && defined($value)) {
1.239     raeburn  2037:             my $failed_cloners;
1.178     raeburn  2038:             if ($name eq 'cloners') {
1.239     raeburn  2039:                 $value =~ s/\s//g;
1.178     raeburn  2040:                 $value =~ s/^,//;
                   2041:                 $value =~ s/,$//;
1.239     raeburn  2042:                 # check requested clones are valid users.
                   2043:                 $failed_cloners = &check_cloners(\$value,\@oldcloner);
1.178     raeburn  2044:             }
1.105     matthew  2045:             my $put_result = &Apache::lonnet::put('environment',
                   2046:                                                   {$name=>$value},$dom,$crs);
                   2047:             if ($put_result eq 'ok') {
1.130     www      2048:                 $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178     raeburn  2049:                 if ($name eq 'cloners') {
                   2050:                     &change_clone($value,\@oldcloner);
                   2051:                 }
1.179     raeburn  2052:                 # Flush the course logs so course description is immediately updated
                   2053:                 if ($name eq 'description' && defined($value)) {
                   2054:                     &Apache::lonnet::flushcourselogs();
                   2055:                 }
1.105     matthew  2056:             } else {
1.130     www      2057:                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
                   2058: 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30      www      2059:             }
1.239     raeburn  2060:             if (($name eq 'cloners') && ($failed_cloners)) {
                   2061:                 $setoutput.= &mt('Unable to include').' - <b>'.$failed_cloners.'</b>, '.
                   2062:                  &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
                   2063:                  '.<br />'.&mt('Please ').
                   2064:                  ' <a href="/adm/createuser">'.
                   2065:                  &mt('add the user(s)').'</a>, '.
                   2066:                  &mt('and then return to the ').
                   2067:                  '<a href="/admparmset?action=crsenv">'.
                   2068:                  &mt('Course Parameters page').'</a> '.
                   2069:                  &mt('to add the new user(s) to the list of possible cloners').
                   2070:                  '.<br />';
                   2071:             }
1.30      www      2072:         }
1.38      harris41 2073:     }
1.108     www      2074: # ------------------------- Re-init course environment entries for this session
                   2075: 
1.296     albertel 2076:     &Apache::lonnet::coursedescription($env{'request.course.id'}
                   2077: 				       {'freshen_cache' => 1});
1.105     matthew  2078: 
1.30      www      2079: # -------------------------------------------------------- Get parameters again
1.45      matthew  2080: 
                   2081:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140     sakharuk 2082:     my $SelectStyleFile=&mt('Select Style File');
1.141     sakharuk 2083:     my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30      www      2084:     my $output='';
1.45      matthew  2085:     if (! exists($values{'con_lost'})) {
1.30      www      2086:         my %descriptions=
1.140     sakharuk 2087: 	    ('url'            => '<b>'.&mt('Top Level Map').'</b> '.
1.46      matthew  2088:                                  '<a href="javascript:openbrowser'.
1.47      matthew  2089:                                  "('envform','url','sequence')\">".
1.140     sakharuk 2090:                                  &mt('Select Map').'</a><br /><font color=red> '.
                   2091:                                  &mt('Modification may make assessment data inaccessible').
                   2092:                                  '</font>',
                   2093:              'description'    => '<b>'.&mt('Course Description').'</b>',
1.158     sakharuk 2094:              'courseid'       => '<b>'.&mt('Course ID or number').
1.140     sakharuk 2095:                                  '</b><br />'.
                   2096:                                  '('.&mt('internal').', '.&mt('optional').')',
1.177     raeburn  2097:              'cloners'        => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
1.150     www      2098:              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                   2099:                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140     sakharuk 2100:              'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52      www      2101:                     '<a href="javascript:openbrowser'.
                   2102:                     "('envform','default_xml_style'".
1.140     sakharuk 2103:                     ",'sty')\">$SelectStyleFile</a><br>",
1.141     sakharuk 2104:              'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
                   2105:                                  '</b><br />(<tt>user:domain,'.
1.74      www      2106:                                  'user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2107:              'comment.email'  => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74      www      2108:                                  '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2109:              'policy.email'   => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75      albertel 2110:                                  '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 2111:              'hideemptyrows'  => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158     sakharuk 2112:                                  '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141     sakharuk 2113:              'pageseparators'  => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158     sakharuk 2114:                                  '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141     sakharuk 2115:                                  &mt('changes will not show until next login').')',
1.169     matthew  2116:              'student_classlist_view' => '<b>'.&mt('Allow students to view classlist.').'</b>'.&mt('("all":students can view all sections,"section":students can only view their own section.blank or "disabled" prevents student view.'),
1.118     matthew  2117: 
1.141     sakharuk 2118:              'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
                   2119:                                   '</b><br />"<tt>st</tt>": '.
1.158     sakharuk 2120:                                   &mt('student').', "<tt>ta</tt>": '.
1.118     matthew  2121:                                   'TA, "<tt>in</tt>": '.
1.158     sakharuk 2122:                                   &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118     matthew  2123: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                   2124:              'plc.users.denied' => 
1.141     sakharuk 2125:                           '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118     matthew  2126:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   2127: 
1.141     sakharuk 2128:              'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
                   2129:                                   '</b><br />"<tt>st</tt>": '.
1.61      albertel 2130:                                   'student, "<tt>ta</tt>": '.
                   2131:                                   'TA, "<tt>in</tt>": '.
1.75      albertel 2132:                                   'instructor;<br /><tt>role,role,...</tt>) '.
1.61      albertel 2133: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53      www      2134:              'pch.users.denied' => 
1.141     sakharuk 2135:                           '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53      www      2136:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  2137:              'spreadsheet_default_classcalc' 
1.141     sakharuk 2138:                  => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50      matthew  2139:                     '<a href="javascript:openbrowser'.
                   2140:                     "('envform','spreadsheet_default_classcalc'".
1.141     sakharuk 2141:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2142:              'spreadsheet_default_studentcalc' 
1.141     sakharuk 2143:                  => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50      matthew  2144:                     '<a href="javascript:openbrowser'.
                   2145:                     "('envform','spreadsheet_default_calc'".
1.141     sakharuk 2146:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2147:              'spreadsheet_default_assesscalc' 
1.141     sakharuk 2148:                  => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50      matthew  2149:                     '<a href="javascript:openbrowser'.
                   2150:                     "('envform','spreadsheet_default_assesscalc'".
1.141     sakharuk 2151:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75      albertel 2152: 	     'allow_limited_html_in_feedback'
1.141     sakharuk 2153: 	         => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158     sakharuk 2154: 	            '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170     raeburn  2155:              'allow_discussion_post_editing'
1.276     raeburn  2156:                  => '<b>'.&mt('Allow users with specified roles to edit/delete their own discussion posts').'</b><br />"<tt>st</tt>": '.
                   2157:                                   &mt('student').', "<tt>ta</tt>": '.
                   2158:                                   'TA, "<tt>in</tt>": '.
                   2159:                                   &mt('instructor').';&nbsp;(<tt>'.&mt('role:section,role:section,..., e.g., st:001,st:002,in,cc would permit students in sections 001 and 002 and instructors in any section, and course coordinators to edit their own posts.').'</tt>)<br />'.
                   2160:                     '('.&mt('or set value to "[_1]" to allow all roles',"<tt>yes</tt>").')',
1.89      albertel 2161: 	     'rndseed'
1.140     sakharuk 2162: 	         => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
                   2163:                     '<font color="red">'.&mt('Modifying this will make problems').' '.
                   2164:                     &mt('have different numbers and answers').'</font>',
1.151     albertel 2165: 	     'receiptalg'
                   2166: 	         => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
                   2167:                     &mt('This controls how receipt numbers are generated.'),
1.164     sakharuk 2168:              'suppress_tries'
1.272     albertel 2169:                  => '<b>'.&mt('Suppress number of tries in printing').'</b><br />'.
1.273     www      2170:                     ' ('.&mt('"[_1]" to suppress, anything else to not suppress','<tt>yes</tt>').')',
1.113     sakharuk 2171:              'problem_stream_switch'
1.141     sakharuk 2172:                  => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158     sakharuk 2173:                     ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161     sakharuk 2174:              'default_paper_size' 
                   2175:                  => '<b>'.&mt('Default paper type').'</b><br />'.
                   2176:                     ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'. 
                   2177:                     ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'. 
                   2178:                     ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111     sakharuk 2179:              'anonymous_quiz'
1.150     www      2180:                  => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141     sakharuk 2181:                     ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
1.217     albertel 2182:              'default_enrollment_start_date' => '<b>'.&mt('Default beginning date for student access.').'</b>',
                   2183:              'default_enrollment_end_date'   => '<b>'.&mt('Default ending date for student access.').'</b>',
1.150     www      2184:              'nothideprivileged'   => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
                   2185:                                  '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140     sakharuk 2186:              'languages' => '<b>'.&mt('Languages used').'</b>',
1.115     www      2187:              'disable_receipt_display'
1.141     sakharuk 2188:                  => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158     sakharuk 2189:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163     albertel 2190: 	     'disablesigfigs'
                   2191: 	         => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
                   2192:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.251     albertel 2193: 	     'disableexampointprint'
                   2194: 	         => '<b>'.&mt('Disable automatically printing point values onto exams.').'</b><br />'.
                   2195:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.278     www      2196:              'externalsyllabus'
1.279     www      2197:                  => '<b>'.&mt('URL of Syllabus (not using internal handler)').'</b>',
1.149     albertel 2198: 	     'tthoptions'
                   2199: 	         => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107     matthew  2200:              ); 
1.177     raeburn  2201:         my @Display_Order = ('url','description','courseid','cloners','grading',
1.278     www      2202:                              'externalsyllabus',
1.107     matthew  2203:                              'default_xml_style','pageseparators',
                   2204:                              'question.email','comment.email','policy.email',
1.169     matthew  2205:                              'student_classlist_view',
1.118     matthew  2206:                              'plc.roles.denied','plc.users.denied',
1.107     matthew  2207:                              'pch.roles.denied','pch.users.denied',
                   2208:                              'allow_limited_html_in_feedback',
1.170     raeburn  2209:                              'allow_discussion_post_editing',
1.108     www      2210:                              'languages',
1.150     www      2211: 			     'nothideprivileged',
1.107     matthew  2212:                              'rndseed',
1.151     albertel 2213:                              'receiptalg',
1.107     matthew  2214:                              'problem_stream_switch',
1.164     sakharuk 2215: 			     'suppress_tries',
1.161     sakharuk 2216:                              'default_paper_size',
1.115     www      2217:                              'disable_receipt_display',
1.107     matthew  2218:                              'spreadsheet_default_classcalc',
                   2219:                              'spreadsheet_default_studentcalc',
                   2220:                              'spreadsheet_default_assesscalc', 
                   2221:                              'hideemptyrows',
                   2222:                              'default_enrollment_start_date',
                   2223:                              'default_enrollment_end_date',
1.163     albertel 2224: 			     'tthoptions',
1.251     albertel 2225: 			     'disablesigfigs',
                   2226: 			     'disableexampointprint'
1.107     matthew  2227:                              );
                   2228: 	foreach my $parameter (sort(keys(%values))) {
1.244     banghart 2229:             unless (($parameter =~ m/^internal\./)||($parameter =~ m/^metadata\./)) {
1.142     raeburn  2230:                 if (! $descriptions{$parameter}) {
                   2231:                     $descriptions{$parameter}=$parameter;
                   2232:                     push(@Display_Order,$parameter);
                   2233:                 }
                   2234:             }
1.43      albertel 2235: 	}
1.107     matthew  2236:         foreach my $parameter (@Display_Order) {
                   2237:             my $description = $descriptions{$parameter};
1.51      matthew  2238:             # onchange is javascript to automatically check the 'Set' button.
1.69      www      2239:             my $onchange = 'onFocus="javascript:window.document.forms'.
1.107     matthew  2240:                 "['envform'].elements['".$parameter."_setparmval']".
1.51      matthew  2241:                 '.checked=true;"';
1.107     matthew  2242:             $output .= '<tr><td>'.$description.'</td>';
                   2243:             if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
                   2244:                 $output .= '<td>'.
                   2245:                     &Apache::lonhtmlcommon::date_setter('envform',
                   2246:                                                         $parameter.'_value',
                   2247:                                                         $values{$parameter},
                   2248:                                                         $onchange).
                   2249:                                                         '</td>';
                   2250:             } else {
                   2251:                 $output .= '<td>'.
                   2252:                     &Apache::lonhtmlcommon::textbox($parameter.'_value',
                   2253:                                                     $values{$parameter},
                   2254:                                                     40,$onchange).'</td>';
                   2255:             }
                   2256:             $output .= '<td>'.
                   2257:                 &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                   2258:                 '</td>';
                   2259:             $output .= "</tr>\n";
1.51      matthew  2260: 	}
1.69      www      2261:         my $onchange = 'onFocus="javascript:window.document.forms'.
1.51      matthew  2262:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   2263:             '.checked=true;"';
1.130     www      2264: 	$output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51      matthew  2265: 	    '<input type="text" size=40 name="newp_name" '.
                   2266:                 $onchange.' /></td><td>'.
                   2267:             '<input type="text" size=40 name="newp_value" '.
                   2268:                 $onchange.' /></td><td>'.
                   2269: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 2270:     }
1.157     sakharuk 2271:     my %lt=&Apache::lonlocal::texthash(
                   2272: 		    'par'   => 'Parameter',
                   2273: 		    'val'   => 'Value',
                   2274: 		    'set'   => 'Set',
                   2275: 		    'sce'   => 'Set Course Environment'
                   2276: 				       );
                   2277: 
1.140     sakharuk 2278:     my $Parameter=&mt('Parameter');
                   2279:     my $Value=&mt('Value');
1.141     sakharuk 2280:     my $Set=&mt('Set');
1.280     albertel 2281:     my $browse_js=
                   2282: 	'<script type="text/javascript" language="Javascript">'.
                   2283: 	&Apache::loncommon::browser_and_searcher_javascript('parmset').
                   2284: 	'</script>';
                   2285:     
                   2286:     my $start_page = 
                   2287: 	&Apache::loncommon::start_page('Set Course Environment Parameters',
                   2288: 				       $browse_js);
                   2289:     my $end_page = 
                   2290: 	&Apache::loncommon::end_page();
                   2291:     $r->print(<<ENDENV);
                   2292: $start_page
1.193     albertel 2293: $breadcrumbs
                   2294: <form method="post" action="/adm/parmset?action=crsenv" name="envform">
1.30      www      2295: $setoutput
                   2296: <p>
                   2297: <table border=2>
1.157     sakharuk 2298: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30      www      2299: $output
                   2300: </table>
1.157     sakharuk 2301: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30      www      2302: </form>
1.280     albertel 2303: $end_page
                   2304: ENDENV
1.30      www      2305: }
1.120     www      2306: ##################################################
1.207     www      2307: # Overview mode
                   2308: ##################################################
1.124     www      2309: my $tableopen;
                   2310: 
                   2311: sub tablestart {
                   2312:     if ($tableopen) {
                   2313: 	return '';
                   2314:     } else {
                   2315: 	$tableopen=1;
1.295     albertel 2316: 	return &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th><th>'.
1.130     www      2317: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      2318:     }
                   2319: }
                   2320: 
                   2321: sub tableend {
                   2322:     if ($tableopen) {
                   2323: 	$tableopen=0;
1.295     albertel 2324: 	return &Apache::loncommon::end_data_table();
1.124     www      2325:     } else {
                   2326: 	return'';
                   2327:     }
                   2328: }
                   2329: 
1.207     www      2330: sub readdata {
                   2331:     my ($crs,$dom)=@_;
                   2332: # Read coursedata
                   2333:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2334: # Read userdata
                   2335: 
                   2336:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2337:     foreach (keys %$classlist) {
                   2338:         # the following undefs are for 'domain', and 'username' respectively.
                   2339:         if ($_=~/^(\w+)\:(\w+)$/) {
                   2340: 	    my ($tuname,$tudom)=($1,$2);
                   2341: 	    my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   2342:             foreach my $userkey (keys %{$useropt}) {
                   2343: 		if ($userkey=~/^$env{'request.course.id'}/) {
                   2344:                     my $newkey=$userkey;
                   2345: 		    $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2346: 		    $$resourcedata{$newkey}=$$useropt{$userkey};
                   2347: 		}
                   2348: 	    }
                   2349: 	}
                   2350:     }
                   2351:     return $resourcedata;
                   2352: }
                   2353: 
                   2354: 
1.124     www      2355: # Setting
1.208     www      2356: 
                   2357: sub storedata {
                   2358:     my ($r,$crs,$dom)=@_;
1.207     www      2359: # Set userlevel immediately
                   2360: # Do an intermediate store of course level
                   2361:     my $olddata=&readdata($crs,$dom);
1.124     www      2362:     my %newdata=();
                   2363:     undef %newdata;
                   2364:     my @deldata=();
                   2365:     undef @deldata;
1.190     albertel 2366:     foreach (keys %env) {
1.124     www      2367: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   2368: 	    my $cmd=$1;
                   2369: 	    my $thiskey=$2;
1.207     www      2370: 	    my ($tuname,$tudom)=&extractuser($thiskey);
                   2371: 	    my $tkey=$thiskey;
                   2372:             if ($tuname) {
                   2373: 		$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2374: 	    }
1.124     www      2375: 	    if ($cmd eq 'set') {
1.190     albertel 2376: 		my $data=$env{$_};
1.212     www      2377:                 my $typeof=$env{'form.typeof_'.$thiskey};
                   2378:  		if ($$olddata{$thiskey} ne $data) { 
1.207     www      2379: 		    if ($tuname) {
1.212     www      2380: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2381: 								 $tkey.'.type' => $typeof},
                   2382: 						 $tudom,$tuname) eq 'ok') {
1.290     www      2383: 			    &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
1.207     www      2384: 			    $r->print('<br />'.&mt('Stored modified parameter for').' '.
                   2385: 				      &Apache::loncommon::plainname($tuname,$tudom));
                   2386: 			} else {
                   2387: 			    $r->print('<h2><font color="red">'.
                   2388: 				      &mt('Error storing parameters').'</font></h2>');
                   2389: 			}
                   2390: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2391: 		    } else {
                   2392: 			$newdata{$thiskey}=$data;
1.212     www      2393:  			$newdata{$thiskey.'.type'}=$typeof; 
                   2394:                    } 
1.207     www      2395: 		}
1.124     www      2396: 	    } elsif ($cmd eq 'del') {
1.207     www      2397: 		if ($tuname) {
                   2398: 		    if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
1.290     www      2399: 			    &log_parmset({$tkey=>''},1,$tuname,$tudom);
1.207     www      2400: 			$r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2401: 		    } else {
                   2402: 			$r->print('<h2><font color="red">'.
                   2403: 				  &mt('Error deleting parameters').'</font></h2>');
                   2404: 		    }
                   2405: 		    &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2406: 		} else {
                   2407: 		    push (@deldata,$thiskey);
                   2408: 		}
1.124     www      2409: 	    } elsif ($cmd eq 'datepointer') {
1.190     albertel 2410: 		my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
1.212     www      2411:                 my $typeof=$env{'form.typeof_'.$thiskey};
1.207     www      2412: 		if (defined($data) and $$olddata{$thiskey} ne $data) { 
                   2413: 		    if ($tuname) {
1.212     www      2414: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2415: 								 $tkey.'.type' => $typeof},
                   2416: 						 $tudom,$tuname) eq 'ok') {
1.290     www      2417: 			    &log_parmset({$tkey=>$data,$tkey.'.type' => $typeof},0,$tuname,$tudom);
1.207     www      2418: 			    $r->print('<br />'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2419: 			} else {
                   2420: 			    $r->print('<h2><font color="red">'.
                   2421: 				      &mt('Error storing parameters').'</font></h2>');
                   2422: 			}
                   2423: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2424: 		    } else {
1.212     www      2425: 			$newdata{$thiskey}=$data;
                   2426: 			$newdata{$thiskey.'.type'}=$typeof; 
1.207     www      2427: 		    }
                   2428: 		}
1.124     www      2429: 	    }
                   2430: 	}
                   2431:     }
1.207     www      2432: # Store all course level
1.144     www      2433:     my $delentries=$#deldata+1;
                   2434:     my @newdatakeys=keys %newdata;
                   2435:     my $putentries=$#newdatakeys+1;
                   2436:     if ($delentries) {
                   2437: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
1.290     www      2438: 	    my %loghash=map { $_ => '' } @deldata;
                   2439: 	    &log_parmset(\%loghash,1);
1.144     www      2440: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   2441: 	} else {
                   2442: 	    $r->print('<h2><font color="red">'.
                   2443: 		      &mt('Error deleting parameters').'</font></h2>');
                   2444: 	}
1.205     www      2445: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2446:     }
                   2447:     if ($putentries) {
                   2448: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1.290     www      2449: 			    &log_parmset(\%newdata,0);
1.212     www      2450: 	    $r->print('<h3>'.&mt('Stored [_1] parameter(s)',$putentries/2).'</h3>');
1.144     www      2451: 	} else {
                   2452: 	    $r->print('<h2><font color="red">'.
                   2453: 		      &mt('Error storing parameters').'</font></h2>');
                   2454: 	}
1.205     www      2455: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2456:     }
1.208     www      2457: }
1.207     www      2458: 
1.208     www      2459: sub extractuser {
                   2460:     my $key=shift;
                   2461:     return ($key=~/^$env{'request.course.id'}.\[useropt\:(\w+)\:(\w+)\]\./);
                   2462: }
1.206     www      2463: 
1.208     www      2464: sub listdata {
1.214     www      2465:     my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207     www      2466: # Start list output
1.206     www      2467: 
1.122     www      2468:     my $oldsection='';
                   2469:     my $oldrealm='';
                   2470:     my $oldpart='';
1.123     www      2471:     my $pointer=0;
1.124     www      2472:     $tableopen=0;
1.145     www      2473:     my $foundkeys=0;
1.248     albertel 2474:     my %keyorder=&standardkeyorder();
1.214     www      2475:     foreach my $thiskey (sort {
                   2476: 	if ($sortorder eq 'realmstudent') {
1.247     albertel 2477: 	    my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2478: 	    my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2479: 	    if (!defined($astudent)) {
                   2480: 		($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.237     albertel 2481: 	    }
1.247     albertel 2482: 	    if (!defined($bstudent)) {
                   2483: 		($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
                   2484: 	    }
1.248     albertel 2485: 	    $arealm=~s/\.type//;
                   2486: 	    my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/);
                   2487: 	    $aparm=$keyorder{'parameter_0_'.$aparm};
                   2488: 	    $brealm=~s/\.type//;
                   2489: 	    my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/);
                   2490: 	    $bparm=$keyorder{'parameter_0_'.$bparm};	   
                   2491: 	    if ($ares eq $bres) {
                   2492: 		if (defined($aparm) && defined($bparm)) {
                   2493: 		    ($aparm <=> $bparm);
                   2494: 		} elsif (defined($aparm)) {
                   2495: 		    -1;
                   2496: 		} elsif (defined($bparm)) {
                   2497: 		    1;
                   2498: 		} else {
                   2499: 		    ($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2500: 		}
                   2501: 	    } else {
                   2502: 		($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2503: 	    }
1.214     www      2504: 	} else {
                   2505: 	    $a cmp $b;
                   2506: 	}
                   2507:     } keys %{$listdata}) {
1.247     albertel 2508: 	 
1.211     www      2509: 	if ($$listdata{$thiskey.'.type'}) {
                   2510:             my $thistype=$$listdata{$thiskey.'.type'};
                   2511:             if ($$resourcedata{$thiskey.'.type'}) {
                   2512: 		$thistype=$$resourcedata{$thiskey.'.type'};
                   2513: 	    }
1.207     www      2514: 	    my ($middle,$part,$name)=
                   2515: 		($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      2516: 	    my $section=&mt('All Students');
1.207     www      2517: 	    if ($middle=~/^\[(.*)\]/) {
1.206     www      2518: 		my $issection=$1;
                   2519: 		if ($issection=~/^useropt\:(\w+)\:(\w+)/) {
                   2520: 		    $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   2521: 		} else {
                   2522: 		    $section=&mt('Group/Section').': '.$issection;
                   2523: 		}
1.207     www      2524: 		$middle=~s/^\[(.*)\]//;
1.122     www      2525: 	    }
1.207     www      2526: 	    $middle=~s/\.+$//;
                   2527: 	    $middle=~s/^\.+//;
1.130     www      2528: 	    my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122     www      2529: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174     albertel 2530: 		$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122     www      2531: 	    } elsif ($middle) {
1.174     albertel 2532: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   2533: 		$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
1.122     www      2534: 	    }
1.214     www      2535: 	    if ($sortorder eq 'realmstudent') {
                   2536: 		if ($realm ne $oldrealm) {
                   2537: 		    $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   2538: 		    $oldrealm=$realm;
                   2539: 		    $oldsection='';
                   2540: 		}
                   2541: 		if ($section ne $oldsection) {
                   2542: 		    $r->print(&tableend()."\n<h2>$section</h2>");
                   2543: 		    $oldsection=$section;
                   2544: 		    $oldpart='';
                   2545: 		}
                   2546: 	    } else {
                   2547: 		if ($section ne $oldsection) {
                   2548: 		    $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   2549: 		    $oldsection=$section;
                   2550: 		    $oldrealm='';
                   2551: 		}
                   2552: 		if ($realm ne $oldrealm) {
                   2553: 		    $r->print(&tableend()."\n<h2>$realm</h2>");
                   2554: 		    $oldrealm=$realm;
                   2555: 		    $oldpart='';
                   2556: 		}
1.122     www      2557: 	    }
                   2558: 	    if ($part ne $oldpart) {
1.124     www      2559: 		$r->print(&tableend().
1.214     www      2560: 			  "\n<font color='blue'>".&mt('Part').": $part</font>");
1.122     www      2561: 		$oldpart=$part;
                   2562: 	    }
1.123     www      2563: #
1.230     www      2564: # Preset defaults?
                   2565: #
                   2566:             my ($hour,$min,$sec,$val)=('','','','');
                   2567: 	    unless ($$resourcedata{$thiskey}) {
                   2568: 		my ($parmname)=($thiskey=~/\.(\w+)$/);
                   2569: 		($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   2570: 	    }
                   2571: 
                   2572: #
1.123     www      2573: # Ready to print
                   2574: #
1.295     albertel 2575: 	    $r->print(&tablestart().
                   2576: 		      &Apache::loncommon::start_data_table_row().
                   2577: 		      '<td><b>'.&standard_parameter_names($name).
1.293     www      2578: 		      '</b></td><td><input type="checkbox" name="del_'.
1.124     www      2579: 		      $thiskey.'" /></td><td>');
1.145     www      2580: 	    $foundkeys++;
1.213     www      2581: 	    if (&isdateparm($thistype)) {
1.123     www      2582: 		my $jskey='key_'.$pointer;
                   2583: 		$pointer++;
                   2584: 		$r->print(
1.232     albertel 2585: 			  &Apache::lonhtmlcommon::date_setter('parmform',
1.123     www      2586: 							      $jskey,
1.219     www      2587: 						      $$resourcedata{$thiskey},
1.230     www      2588: 							      '',1,'','',$hour,$min,$sec).
1.277     www      2589: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
                   2590: &date_sanity_info($$resourcedata{$thiskey})
1.123     www      2591: 			  );
1.219     www      2592: 	    } elsif ($thistype eq 'string_yesno') {
1.230     www      2593: 		my $showval;
                   2594: 		if (defined($$resourcedata{$thiskey})) {
                   2595: 		    $showval=$$resourcedata{$thiskey};
                   2596: 		} else {
                   2597: 		    $showval=$val;
                   2598: 		}
1.219     www      2599: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2600: 			  '" value="yes"');
1.230     www      2601: 		if ($showval eq 'yes') {
1.219     www      2602: 		    $r->print(' checked="checked"');
                   2603: 		}
                   2604:                 $r->print(' />'.&mt('Yes').'</label> ');
                   2605: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2606: 			  '" value="no"');
1.230     www      2607: 		if ($showval eq 'no') {
1.219     www      2608: 		    $r->print(' checked="checked"');
                   2609: 		}
                   2610:                 $r->print(' />'.&mt('No').'</label>');
1.123     www      2611: 	    } else {
1.230     www      2612: 		my $showval;
                   2613: 		if (defined($$resourcedata{$thiskey})) {
                   2614: 		    $showval=$$resourcedata{$thiskey};
                   2615: 		} else {
                   2616: 		    $showval=$val;
                   2617: 		}
1.211     www      2618: 		$r->print('<input type="text" name="set_'.$thiskey.'" value="'.
1.230     www      2619: 			  $showval.'">');
1.123     www      2620: 	    }
1.211     www      2621: 	    $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   2622: 		      $thistype.'">');
1.295     albertel 2623: 	    $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.122     www      2624: 	}
1.121     www      2625:     }
1.208     www      2626:     return $foundkeys;
                   2627: }
                   2628: 
                   2629: sub newoverview {
1.280     albertel 2630:     my ($r) = @_;
                   2631: 
1.208     www      2632:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2633:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 2634:     my $start_page = &Apache::loncommon::start_page('Set Parameters');
1.298     albertel 2635:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      2636:     $r->print(<<ENDOVER);
1.280     albertel 2637: $start_page
1.208     www      2638: $breadcrumbs
1.232     albertel 2639: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      2640: ENDOVER
1.211     www      2641:     my @ids=();
                   2642:     my %typep=();
                   2643:     my %keyp=();
                   2644:     my %allparms=();
                   2645:     my %allparts=();
                   2646:     my %allmaps=();
                   2647:     my %mapp=();
                   2648:     my %symbp=();
                   2649:     my %maptitles=();
                   2650:     my %uris=();
                   2651:     my %keyorder=&standardkeyorder();
                   2652:     my %defkeytype=();
                   2653: 
                   2654:     my %alllevs=();
                   2655:     $alllevs{'Resource Level'}='full';
1.215     www      2656:     $alllevs{'Map/Folder Level'}='map';
1.211     www      2657:     $alllevs{'Course Level'}='general';
                   2658: 
                   2659:     my $csec=$env{'form.csec'};
1.269     raeburn  2660:     my $cgroup=$env{'form.cgroup'};
1.211     www      2661: 
                   2662:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   2663:     my $pschp=$env{'form.pschp'};
                   2664:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
                   2665:     if (!@psprt) { $psprt[0]='0'; }
                   2666: 
                   2667:     my @selected_sections = 
                   2668: 	&Apache::loncommon::get_env_multiple('form.Section');
                   2669:     @selected_sections = ('all') if (! @selected_sections);
                   2670:     foreach (@selected_sections) {
                   2671:         if ($_ eq 'all') {
                   2672:             @selected_sections = ('all');
                   2673:         }
                   2674:     }
1.269     raeburn  2675:     my @selected_groups =
                   2676:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      2677: 
                   2678:     my $pssymb='';
                   2679:     my $parmlev='';
                   2680:  
                   2681:     unless ($env{'form.parmlev'}) {
                   2682:         $parmlev = 'map';
                   2683:     } else {
                   2684:         $parmlev = $env{'form.parmlev'};
                   2685:     }
                   2686: 
                   2687:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   2688: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   2689: 				\%keyorder,\%defkeytype);
                   2690: 
                   2691: # Menu to select levels, etc
                   2692: 
                   2693:     $r->print('<table border="1"><tr><td>');
                   2694:     &levelmenu($r,\%alllevs,$parmlev);
                   2695:     if ($parmlev ne 'general') {
                   2696: 	$r->print('<td>');
                   2697: 	&mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   2698: 	$r->print('</td>');
                   2699:     }
                   2700:     $r->print('</td></tr></table>');
                   2701: 
                   2702:     $r->print('<table border="1"><tr><td>');  
                   2703:     &parmmenu($r,\%allparms,\@pscat,\%keyorder);
1.269     raeburn  2704:     $r->print('</td><td><table border="0" cellspacing="0" cellpadding="0">'.
                   2705:               '<tr><td>'.&mt('Parts').'</td><td></td><td>'.&mt('Section(s)').
                   2706:               '</td><td></td><td>'.&mt('Group(s)').'</td></tr><tr><td>');
1.211     www      2707:     &partmenu($r,\%allparts,\@psprt);
1.269     raeburn  2708:     $r->print('</td><td>&nbsp;</td><td>');
1.211     www      2709:     &sectionmenu($r,\@selected_sections);
1.269     raeburn  2710:     $r->print('</td><td>&nbsp;</td><td>');
                   2711:     &groupmenu($r,\@selected_groups);
                   2712:     $r->print('</td></tr></table>');
1.214     www      2713:     $r->print('</td></tr></table>');
                   2714:  
                   2715:     my $sortorder=$env{'form.sortorder'};
                   2716:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2717:     &sortmenu($r,$sortorder);
                   2718: 
                   2719:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.211     www      2720: 
                   2721: # Build the list data hash from the specified parms
                   2722: 
                   2723:     my $listdata;
                   2724:     %{$listdata}=();
                   2725: 
                   2726:     foreach my $cat (@pscat) {
1.269     raeburn  2727:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   2728:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      2729:     }
                   2730: 
1.212     www      2731:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      2732: 
1.212     www      2733: 	if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      2734: 
                   2735: # Read modified data
                   2736: 
                   2737: 	my $resourcedata=&readdata($crs,$dom);
                   2738: 
                   2739: # List data
                   2740: 
1.214     www      2741: 	&listdata($r,$resourcedata,$listdata,$sortorder);
1.211     www      2742:     }
                   2743:     $r->print(&tableend().
1.212     www      2744: 	     ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Store').'" /></p>':'').
1.280     albertel 2745: 	      '</form>'.&Apache::loncommon::end_page());
1.208     www      2746: }
                   2747: 
1.269     raeburn  2748: sub secgroup_lister {
                   2749:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   2750:     foreach my $item (@{$selections}) {
                   2751:         foreach my $part (@{$psprt}) {
                   2752:             my $rootparmkey=$env{'request.course.id'};
                   2753:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   2754:                 $rootparmkey.='.['.$item.']';
                   2755:             }
                   2756:             if ($parmlev eq 'general') {
                   2757: # course-level parameter
                   2758:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   2759:                 $$listdata{$newparmkey}=1;
                   2760:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2761:             } elsif ($parmlev eq 'map') {
                   2762: # map-level parameter
                   2763:                 foreach my $mapid (keys %{$allmaps}) {
                   2764:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   2765:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   2766:                     $$listdata{$newparmkey}=1;
                   2767:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2768:                 }
                   2769:             } else {
                   2770: # resource-level parameter
                   2771:                 foreach my $rid (@{$ids}) {
                   2772:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   2773:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   2774:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   2775:                     $$listdata{$newparmkey}=1;
                   2776:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2777:                 }
                   2778:             }
                   2779:         }
                   2780:     }
                   2781: }
                   2782: 
1.208     www      2783: sub overview {
1.280     albertel 2784:     my ($r) = @_;
1.208     www      2785:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2786:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.280     albertel 2787: 
                   2788:     my $start_page=&Apache::loncommon::start_page('Modify Parameters');
1.298     albertel 2789:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.208     www      2790:     $r->print(<<ENDOVER);
1.280     albertel 2791: $start_page
1.208     www      2792: $breadcrumbs
1.232     albertel 2793: <form method="post" action="/adm/parmset?action=setoverview" name="parmform">
1.208     www      2794: ENDOVER
                   2795: # Store modified
                   2796: 
                   2797:     &storedata($r,$crs,$dom);
                   2798: 
                   2799: # Read modified data
                   2800: 
                   2801:     my $resourcedata=&readdata($crs,$dom);
                   2802: 
1.214     www      2803: 
                   2804:     my $sortorder=$env{'form.sortorder'};
                   2805:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2806:     &sortmenu($r,$sortorder);
                   2807: 
1.208     www      2808: # List data
                   2809: 
1.214     www      2810:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208     www      2811: 
1.145     www      2812:     $r->print(&tableend().'<p>'.
1.280     albertel 2813: 	($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no parameters.')).'</p></form>'.
                   2814: 	      &Apache::loncommon::end_page());
1.120     www      2815: }
1.121     www      2816: 
1.59      matthew  2817: ##################################################
                   2818: ##################################################
1.178     raeburn  2819:                                                                                             
                   2820: =pod
1.239     raeburn  2821: 
                   2822: =item check_cloners
                   2823: 
                   2824: Checks if new users included in list of allowed cloners
                   2825: are valid users.  Replaces supplied list with 
                   2826: cleaned list containing only users with valid usernames
                   2827: and domains.
                   2828: 
                   2829: Inputs: $clonelist, $oldcloner 
                   2830: where $clonelist is ref to array of requested cloners,
                   2831: and $oldcloner is ref to array of currently allowed
                   2832: cloners.
                   2833: 
                   2834: Returns: string - comma separated list of requested
                   2835: cloners (username:domain) who do not exist in system.
                   2836: 
                   2837: =item change_clone
                   2838: 
1.178     raeburn  2839: Modifies the list of courses a user can clone (stored
1.239     raeburn  2840: in the user's environment.db file), called when a
1.178     raeburn  2841: change is made to the list of users allowed to clone
                   2842: a course.
1.239     raeburn  2843: 
1.178     raeburn  2844: Inputs: $action,$cloner
                   2845: where $action is add or drop, and $cloner is identity of 
                   2846: user for whom cloning ability is to be changed in course. 
                   2847: 
                   2848: =cut
                   2849:                                                                                             
                   2850: ##################################################
                   2851: ##################################################
                   2852: 
1.239     raeburn  2853: sub extract_cloners {
                   2854:     my ($clonelist,$allowclone) = @_;
                   2855:     if ($clonelist =~ /,/) {
                   2856:         @{$allowclone} = split/,/,$clonelist;
                   2857:     } else {
                   2858:         $$allowclone[0] = $clonelist;
                   2859:     }
                   2860: }
                   2861: 
                   2862: 
                   2863: sub check_cloners {
                   2864:     my ($clonelist,$oldcloner) = @_;
                   2865:     my ($clean_clonelist,$disallowed);
                   2866:     my @allowclone = ();
                   2867:     &extract_cloners($$clonelist,\@allowclone);
                   2868:     foreach my $currclone (@allowclone) {
                   2869:         if (!grep/^$currclone$/,@$oldcloner) {
                   2870:             my ($uname,$udom) = split/:/,$currclone;
                   2871:             if ($uname && $udom) {
                   2872:                 if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2873:                     $disallowed .= $currclone.',';   
                   2874:                 } else {
                   2875:                     $clean_clonelist .= $currclone.',';
                   2876:                 }
                   2877:             }
                   2878:         } else {
                   2879:             $clean_clonelist .= $currclone.',';
                   2880:         }
                   2881:     }
                   2882:     if ($disallowed) {
                   2883:         $disallowed =~ s/,$//;
                   2884:     }
                   2885:     if ($clean_clonelist) {
                   2886:         $clean_clonelist =~ s/,$//;
                   2887:     }
                   2888:     $$clonelist = $clean_clonelist;
                   2889:     return $disallowed;
                   2890: }  
1.178     raeburn  2891: 
                   2892: sub change_clone {
                   2893:     my ($clonelist,$oldcloner) = @_;
                   2894:     my ($uname,$udom);
1.190     albertel 2895:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2896:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178     raeburn  2897:     my $clone_crs = $cnum.':'.$cdom;
                   2898:     
                   2899:     if ($cnum && $cdom) {
1.239     raeburn  2900:         my @allowclone;
                   2901:         &extract_cloners($clonelist,\@allowclone);
1.178     raeburn  2902:         foreach my $currclone (@allowclone) {
                   2903:             if (!grep/^$currclone$/,@$oldcloner) {
                   2904:                 ($uname,$udom) = split/:/,$currclone;
                   2905:                 if ($uname && $udom) {
                   2906:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2907:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2908:                         if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   2909:                             if ($currclonecrs{'cloneable'} eq '') {
                   2910:                                 $currclonecrs{'cloneable'} = $clone_crs;
                   2911:                             } else {
                   2912:                                 $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   2913:                             }
                   2914:                             &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                   2915:                         }
                   2916:                     }
                   2917:                 }
                   2918:             }
                   2919:         }
                   2920:         foreach my $oldclone (@$oldcloner) {
                   2921:             if (!grep/^$oldclone$/,@allowclone) {
                   2922:                 ($uname,$udom) = split/:/,$oldclone;
                   2923:                 if ($uname && $udom) {
                   2924:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2925:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2926:                         my %newclonecrs = ();
                   2927:                         if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   2928:                             if ($currclonecrs{'cloneable'} =~ /,/) {
                   2929:                                 my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   2930:                                 foreach (@currclonecrs) {
                   2931:                                     unless ($_ eq $clone_crs) {
                   2932:                                         $newclonecrs{'cloneable'} .= $_.',';
                   2933:                                     }
                   2934:                                 }
                   2935:                                 $newclonecrs{'cloneable'} =~ s/,$//;
                   2936:                             } else {
                   2937:                                 $newclonecrs{'cloneable'} = '';
                   2938:                             }
                   2939:                             &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                   2940:                         }
                   2941:                     }
                   2942:                 }
                   2943:             }
                   2944:         }
                   2945:     }
                   2946: }
                   2947: 
1.193     albertel 2948: 
                   2949: ##################################################
                   2950: ##################################################
                   2951: 
                   2952: =pod
                   2953: 
                   2954: =item * header
                   2955: 
                   2956: Output html header for page
                   2957: 
                   2958: =cut
                   2959: 
                   2960: ##################################################
                   2961: ##################################################
                   2962: sub header {
1.280     albertel 2963:     return &Apache::loncommon::start_page('Parameter Manager');
1.193     albertel 2964: }
                   2965: ##################################################
                   2966: ##################################################
                   2967: sub print_main_menu {
                   2968:     my ($r,$parm_permission)=@_;
                   2969:     #
                   2970:     $r->print(<<ENDMAINFORMHEAD);
                   2971: <form method="post" enctype="multipart/form-data"
                   2972:       action="/adm/parmset" name="studentform">
                   2973: ENDMAINFORMHEAD
                   2974: #
1.195     albertel 2975:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2976:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 2977:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                   2978: 
1.193     albertel 2979:     my @menu =
                   2980:         (
                   2981:           { text => 'Set Course Environment Parameters',
1.204     www      2982: 	    action => 'crsenv',
1.193     albertel 2983:             permission => $parm_permission,
                   2984:             },
1.255     banghart 2985:           { text => 'Set Portfolio Metadata',
1.259     banghart 2986: 	    action => 'setrestrictmeta',
1.240     banghart 2987:             permission => $parm_permission,
                   2988:             },
1.271     www      2989: 	  { text => 'Manage Course Slots',
1.268     albertel 2990: 	    url => '/adm/slotrequest?command=showslots',
                   2991: 	    permission => $vgr,
                   2992:             },
                   2993: 	  { divider => 1,
                   2994: 	    },
1.216     www      2995:           { text => 'Set/Modify Resource Parameters - Helper Mode',
1.193     albertel 2996:             url => '/adm/helper/parameter.helper',
                   2997:             permission => $parm_permission,
                   2998:             },
1.216     www      2999:           { text => 'Modify Resource Parameters - Overview Mode',
1.193     albertel 3000:             action => 'setoverview',
                   3001:             permission => $parm_permission,
1.208     www      3002:             },          
1.216     www      3003: 	  { text => 'Set Resource Parameters - Overview Mode',
1.208     www      3004:             action => 'newoverview',
                   3005:             permission => $parm_permission,
1.193     albertel 3006:             },
1.216     www      3007:           { text => 'Set/Modify Resource Parameters - Table Mode',
1.193     albertel 3008:             action => 'settable',
                   3009:             permission => $parm_permission,
1.204     www      3010:             help => 'Cascading_Parameters',
1.193     albertel 3011:             },
1.220     www      3012:           { text => 'Set Parameter Setting Default Actions',
                   3013:             action => 'setdefaults',
                   3014:             permission => $parm_permission,
1.284     www      3015:             },          
1.292     www      3016: 	  { text => 'Parameter Change Log and Course Blog Posting/User Notification',
1.284     www      3017:             action => 'parameterchangelog',
                   3018:             permission => $parm_permission,
1.220     www      3019:             },
1.193     albertel 3020:           );
                   3021:     my $menu_html = '';
                   3022:     foreach my $menu_item (@menu) {
1.268     albertel 3023: 	if ($menu_item->{'divider'}) {
                   3024: 	    $menu_html .= '<hr />';
                   3025: 	    next;
                   3026: 	}
1.193     albertel 3027:         next if (! $menu_item->{'permission'});
                   3028:         $menu_html.='<p>';
                   3029:         $menu_html.='<font size="+1">';
                   3030:         if (exists($menu_item->{'url'})) {
                   3031:             $menu_html.=qq{<a href="$menu_item->{'url'}">};
                   3032:         } else {
                   3033:             $menu_html.=
                   3034:                 qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
                   3035:         }
                   3036:         $menu_html.= &mt($menu_item->{'text'}).'</a></font>';
                   3037:         if (exists($menu_item->{'help'})) {
                   3038:             $menu_html.=
                   3039:                 &Apache::loncommon::help_open_topic($menu_item->{'help'});
                   3040:         }
                   3041:         $menu_html.='</p>'.$/;
                   3042:     }
                   3043:     $r->print($menu_html);
                   3044:     return;
                   3045: }
1.255     banghart 3046: ### Set portfolio metadata
1.252     banghart 3047: sub output_row {
1.255     banghart 3048:     my ($r, $field_name, $field_text) = @_;
1.252     banghart 3049:     my $output;
1.263     banghart 3050:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   3051:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.254     banghart 3052:     unless (defined($options)) {
                   3053:         $options = 'active,stuadd';
1.261     banghart 3054:         $values = '';
1.252     banghart 3055:     }
1.260     banghart 3056:     $output.='<strong>'.$field_text.':</strong>';
1.264     albertel 3057:     $output.='<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /><br />';
                   3058: 
                   3059:     my @options= ( ['active', 'Show to student'],
                   3060: 		   ['onlyone','Student may select only one choice'],
                   3061: 		   ['stuadd', 'Student may type choices']);
                   3062:     foreach my $opt (@options) {
                   3063: 	my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   3064: 	$output.=('&nbsp;'x5).'<label><input type="checkbox" name="'.
                   3065: 	    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   3066: 	    &mt($opt->[1]).'</label> <br />';
1.252     banghart 3067:     }
                   3068:     return ($output);
                   3069: }
1.259     banghart 3070: 
                   3071: sub setrestrictmeta {
1.240     banghart 3072:     my ($r)=@_;
1.242     banghart 3073:     my $next_meta;
1.244     banghart 3074:     my $output;
1.245     banghart 3075:     my $item_num;
1.246     banghart 3076:     my $put_result;
1.280     albertel 3077:     
                   3078:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 3079:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 3080:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3081:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 3082:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 3083:     my $save_field = '';
1.259     banghart 3084:     if ($env{'form.restrictmeta'}) {
1.254     banghart 3085:         foreach my $field (sort(keys(%env))) {
1.252     banghart 3086:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 3087:                 my $options;
1.252     banghart 3088:                 my $meta_field = $1;
                   3089:                 my $meta_key = $2;
1.253     banghart 3090:                 if ($save_field ne $meta_field) {
1.252     banghart 3091:                     $save_field = $meta_field;
1.253     banghart 3092:             	    if ($env{'form.'.$meta_field.'_stuadd'}) {
1.254     banghart 3093:             	        $options.='stuadd,';
                   3094:             	    } 
1.253     banghart 3095:             	    if ($env{'form.'.$meta_field.'_onlyone'}) {
1.254     banghart 3096:             	        $options.='onlyone,';
                   3097:             	    } 
                   3098:             	    if ($env{'form.'.$meta_field.'_active'}) {
                   3099:             	        $options.='active,';
1.253     banghart 3100:             	    }
1.259     banghart 3101:                     my $name = $save_field;
1.253     banghart 3102:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 3103:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   3104:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 3105:                                                    },$dom,$crs);
1.252     banghart 3106:                 }
                   3107:             }
                   3108:         }
                   3109:     }
1.296     albertel 3110:     &Apache::lonnet::coursedescription($env{'request.course.id'},
                   3111: 				       {'freshen_cache' => 1});
1.258     albertel 3112:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
                   3113:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 3114:         &Apache::lonnet::logthis ($field);
                   3115:         if ($field ne 'courserestricted') {
                   3116: 	    $output.= &output_row($r, $field, $metadata_fields{$field});
                   3117: 	}
1.255     banghart 3118:     }
1.244     banghart 3119:     $r->print(<<ENDenv);       
1.259     banghart 3120:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 3121:         <p>
                   3122:         $output
1.259     banghart 3123:         <input type="submit" name="restrictmeta" value="Update Metadata Restrictions">
1.244     banghart 3124:         </form>
                   3125: ENDenv
1.280     albertel 3126:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 3127:     return 'ok';
                   3128: }
1.220     www      3129: ##################################################
1.193     albertel 3130: 
1.220     www      3131: sub defaultsetter {
1.280     albertel 3132:     my ($r) = @_;
                   3133: 
                   3134:     my $start_page = 
                   3135: 	&Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 3136:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.220     www      3137:     $r->print(<<ENDDEFHEAD);
1.280     albertel 3138: $start_page
1.220     www      3139: $breadcrumbs
                   3140: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   3141: ENDDEFHEAD
1.280     albertel 3142: 
                   3143:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3144:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.221     www      3145:     my @ids=();
                   3146:     my %typep=();
                   3147:     my %keyp=();
                   3148:     my %allparms=();
                   3149:     my %allparts=();
                   3150:     my %allmaps=();
                   3151:     my %mapp=();
                   3152:     my %symbp=();
                   3153:     my %maptitles=();
                   3154:     my %uris=();
                   3155:     my %keyorder=&standardkeyorder();
                   3156:     my %defkeytype=();
                   3157: 
                   3158:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   3159: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   3160: 				\%keyorder,\%defkeytype);
1.224     www      3161:     if ($env{'form.storerules'}) {
                   3162: 	my %newrules=();
                   3163: 	my @delrules=();
1.226     www      3164: 	my %triggers=();
1.225     albertel 3165: 	foreach my $key (keys(%env)) {
                   3166:             if ($key=~/^form\.(\w+)\_action$/) {
1.224     www      3167: 		my $tempkey=$1;
1.226     www      3168: 		my $action=$env{$key};
                   3169:                 if ($action) {
                   3170: 		    $newrules{$tempkey.'_action'}=$action;
                   3171: 		    if ($action ne 'default') {
                   3172: 			my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   3173: 			$triggers{$whichparm}.=$tempkey.':';
                   3174: 		    }
                   3175: 		    $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224     www      3176: 		    if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3177: 			$newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224     www      3178: 			$newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   3179: 			$newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   3180: 			$newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   3181: 		    } else {
                   3182: 			$newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227     www      3183: 			$newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224     www      3184: 		    }
                   3185: 		} else {
1.225     albertel 3186: 		    push(@delrules,$tempkey.'_action');
1.226     www      3187: 		    push(@delrules,$tempkey.'_type');
1.225     albertel 3188: 		    push(@delrules,$tempkey.'_hours');
                   3189: 		    push(@delrules,$tempkey.'_min');
                   3190: 		    push(@delrules,$tempkey.'_sec');
                   3191: 		    push(@delrules,$tempkey.'_value');
1.224     www      3192: 		}
                   3193: 	    }
                   3194: 	}
1.226     www      3195: 	foreach my $key (keys %allparms) {
                   3196: 	    $newrules{$key.'_triggers'}=$triggers{$key};
                   3197: 	}
1.224     www      3198: 	&Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   3199: 	&Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   3200: 	&resetrulescache();
                   3201:     }
1.227     www      3202:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
                   3203: 				       'hours' => 'Hours',
1.221     www      3204: 				       'min' => 'Minutes',
                   3205: 				       'sec' => 'Seconds',
                   3206: 				       'yes' => 'Yes',
                   3207: 				       'no' => 'No');
1.222     www      3208:     my @standardoptions=('','default');
                   3209:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   3210:     my @dateoptions=('','default');
                   3211:     my @datedisplay=('',&mt('Default value when manually setting'));
                   3212:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
                   3213: 	unless ($tempkey) { next; }
                   3214: 	push @standardoptions,'when_setting_'.$tempkey;
                   3215: 	push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   3216: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3217: 	    push @dateoptions,'later_than_'.$tempkey;
                   3218: 	    push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   3219: 	    push @dateoptions,'earlier_than_'.$tempkey;
                   3220: 	    push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   3221: 	} 
                   3222:     }
1.231     www      3223: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   3224: 	  &mt('Automatic setting rules apply to table mode interfaces only.'));
1.221     www      3225:     $r->print("\n<table border='1'><tr><th>".&mt('Rule for parameter').'</th><th>'.
1.222     www      3226: 	      &mt('Action').'</th><th>'.&mt('Value').'</th></tr>');
1.221     www      3227:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222     www      3228: 	unless ($tempkey) { next; }
1.221     www      3229: 	$r->print("\n<tr><td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222     www      3230: 	my $action=&rulescache($tempkey.'_action');
                   3231: 	$r->print('<select name="'.$tempkey.'_action">');
                   3232: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3233: 	    for (my $i=0;$i<=$#dateoptions;$i++) {
                   3234: 		if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   3235: 		$r->print("\n<option value='$dateoptions[$i]'".
                   3236: 			  ($dateoptions[$i] eq $action?' selected="selected"':'').
                   3237: 			  ">$datedisplay[$i]</option>");
                   3238: 	    }
                   3239: 	} else {
                   3240: 	    for (my $i=0;$i<=$#standardoptions;$i++) {
                   3241: 		if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   3242: 		$r->print("\n<option value='$standardoptions[$i]'".
                   3243: 			  ($standardoptions[$i] eq $action?' selected="selected"':'').
                   3244: 			  ">$standarddisplay[$i]</option>");
                   3245: 	    }
                   3246: 	}
                   3247: 	$r->print('</select>');
1.227     www      3248: 	unless (&isdateparm($defkeytype{$tempkey})) {
                   3249: 	    $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   3250: 		      '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   3251: 	}
1.222     www      3252: 	$r->print("\n</td><td>\n");
                   3253: 
1.221     www      3254:         if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3255: 	    my $days=&rulescache($tempkey.'_days');
1.222     www      3256: 	    my $hours=&rulescache($tempkey.'_hours');
                   3257: 	    my $min=&rulescache($tempkey.'_min');
                   3258: 	    my $sec=&rulescache($tempkey.'_sec');
1.221     www      3259: 	    $r->print(<<ENDINPUTDATE);
1.227     www      3260: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      3261: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   3262: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   3263: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      3264: ENDINPUTDATE
                   3265: 	} elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      3266:             my $yeschecked='';
                   3267:             my $nochecked='';
                   3268:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked='checked="checked"'; }
                   3269:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked='checked="checked"'; }
                   3270: 
1.221     www      3271: 	    $r->print(<<ENDYESNO);
1.224     www      3272: <label><input type="radio" name="$tempkey\_value" value="yes" $yeschecked /> $lt{'yes'}</label><br />
                   3273: <label><input type="radio" name="$tempkey\_value" value="no" $nochecked /> $lt{'no'}</label>
1.221     www      3274: ENDYESNO
                   3275:         } else {
1.224     www      3276: 	    $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221     www      3277: 	}
                   3278:         $r->print('</td></tr>');
                   3279:     }
1.224     www      3280:     $r->print("</table>\n<input type='submit' name='storerules' value='".
1.280     albertel 3281: 	      &mt('Store Rules')."' /></form>\n".
                   3282: 	      &Apache::loncommon::end_page());
1.220     www      3283:     return;
                   3284: }
1.193     albertel 3285: 
1.290     www      3286: sub components {
1.291     www      3287:     my ($key,$uname,$udom,$exeuser,$exedomain)=@_;
1.290     www      3288:     my $typeflag=0;
                   3289:     if ($key=~/\.type$/) {
                   3290: 	$key=~s/\.type$//;
                   3291:         $typeflag=1;
                   3292:     }
1.291     www      3293:     my $issection;
1.290     www      3294:     my ($middle,$part,$name)=($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
                   3295:     my $section=&mt('All Students');
                   3296:     if ($middle=~/^\[(.*)\]/) {
1.291     www      3297: 	$issection=$1;
                   3298: 	$section=&mt('Group/Section').': '.$issection;
1.290     www      3299: 	$middle=~s/^\[(.*)\]//;
                   3300:     }
                   3301:     $middle=~s/\.+$//;
                   3302:     $middle=~s/^\.+//;
1.291     www      3303:     if ($uname) {
                   3304: 	$section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   3305: 	$issection='';
                   3306:     }
1.290     www      3307:     my $realm='<font color="red">'.&mt('All Resources').'</font>';
                   3308:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
                   3309: 	$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
                   3310:     } elsif ($middle) {
                   3311: 	my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   3312: 	$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
                   3313:     }
1.291     www      3314:     my $what=$part.'.'.$name;
                   3315:     return ($realm,$section,$name,$part,$typeflag,
                   3316: 	    $what,$middle,$uname,$udom,$issection);
1.290     www      3317: }
1.293     www      3318: 
1.292     www      3319: sub standard_parameter_names {
                   3320:     my ($name)=@_;
                   3321:     my %standard_parms=&Apache::lonlocal::texthash('duedate' => 'Due Date',
                   3322: 						   'answerdate' => 'Answer Date',
                   3323: 						   'opendate' => 'Open Date',
                   3324: 						   'maxtries' => 'Max. Number of Tries',
                   3325: 						   'weight' => 'Weight',
                   3326: 						   'date_start' => 'Starting Date',
1.293     www      3327: 						   'date_end' => 'Ending Date',
                   3328: 						   'int_pos' => 'Positive Integer',
                   3329: 						   'int_zero_pos' => 'Positive Integer or Zero',
                   3330: 						   'hinttries' => 'Number of Tries till Hints appear');
1.292     www      3331:     if ($standard_parms{$name}) {
                   3332: 	return $standard_parms{$name}; 
                   3333:     } else { 
                   3334: 	return $name; 
                   3335:     }
                   3336: }
1.290     www      3337: 
1.285     albertel 3338: sub parm_change_log {
1.284     www      3339:     my ($r)=@_;
                   3340:     &startpage($r);
1.286     www      3341:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',
                   3342: 				      $env{'course.'.$env{'request.course.id'}.'.domain'},
                   3343: 				      $env{'course.'.$env{'request.course.id'}.'.num'});
1.291     www      3344:     my $courseopt=&Apache::lonnet::get_courseresdata($env{'course.'.$env{'request.course.id'}.'.num'},
                   3345: 						     $env{'course.'.$env{'request.course.id'}.'.domain'});
1.286     www      3346:     $r->print('<table border="2">');
1.293     www      3347:     my $bgcolor='#EEEEEE';
1.294     www      3348:     foreach my $id (sort { $parmlog{$b}{'exe_time'}<=>$parmlog{$a}{'exe_time'} } (keys(%parmlog))) {
1.293     www      3349: 	if ($bgcolor eq '#EEEEEE') { $bgcolor='#FFFFCC'; } else { $bgcolor='#EEEEEE'; }
1.294     www      3350:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.290     www      3351: 	my $count=$#changes+1;
1.288     albertel 3352: 	my $time =
1.294     www      3353: 	    &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
1.289     www      3354: 	my $plainname = 
1.294     www      3355: 	    &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   3356: 					  $parmlog{$id}{'exe_udom'});
1.288     albertel 3357: 	my $about_me_link = 
1.289     www      3358: 	    &Apache::loncommon::aboutmewrapper($plainname,
1.294     www      3359: 					       $parmlog{$id}{'exe_uname'},
                   3360: 					       $parmlog{$id}{'exe_udom'});
1.293     www      3361: 	my $send_msg_link='';
1.294     www      3362: 	if ((($parmlog{$id}{'exe_uname'} ne $env{'user.name'}) 
                   3363: 	     || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
1.293     www      3364: 	    $send_msg_link ='<br />'.
1.288     albertel 3365: 		&Apache::loncommon::messagewrapper(&mt('Send message'),
1.294     www      3366: 						   $parmlog{$id}{'exe_uname'},
                   3367: 						   $parmlog{$id}{'exe_udom'});
1.288     albertel 3368: 	}
1.293     www      3369: 	$r->print('<tr bgcolor="'.$bgcolor.'"><td rowspan="'.$count.'">'.$time.'</td>
1.290     www      3370:                        <td rowspan="'.$count.'">'.$about_me_link.
1.294     www      3371: 		  '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   3372: 			          ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
1.290     www      3373: 		  $send_msg_link.'</td>');
                   3374: 	my $makenewrow=0;
                   3375: 	my %istype=();
1.293     www      3376: 	foreach my $changed (reverse(sort(@changes))) {
1.294     www      3377:             my $value=$parmlog{$id}{'logentry'}->{$changed};
1.291     www      3378:             my ($realm,$section,$parmname,$part,$typeflag,$what,$middle,$uname,$udom,$issection)=
1.294     www      3379: 		&components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'});
1.290     www      3380: 	    if ($typeflag) { $istype{$parmname}=$value; }
1.293     www      3381: 	    if ($makenewrow) { $r->print('<tr bgcolor="'.$bgcolor.'">'); } else { $makenewrow=1; }
1.290     www      3382: 	    $r->print('<td>'.$realm.'</td><td>'.$section.'</td><td>'.
1.292     www      3383: 		      &standard_parameter_names($parmname).'</td><td>'.
                   3384: 		      ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>');
1.291     www      3385: 	    my $stillactive=0;
1.294     www      3386: 	    if ($parmlog{$id}{'deleteflag'}) {
1.290     www      3387: 		$r->print(&mt('Deleted'));
1.288     albertel 3388: 	    } else {
1.290     www      3389: 		if ($typeflag) {
1.292     www      3390: 		    $r->print(&mt('Type: [_1]',&standard_parameter_names($value)));
1.290     www      3391: 		} else {
1.291     www      3392: 		    my ($level,@all)=&parmval_by_symb($what,$middle,&Apache::lonnet::metadata($middle,$what),
                   3393: 						      $uname,$udom,$issection,$issection,$courseopt);
                   3394: 		    if (&isdateparm($istype{$parmname})) {
                   3395: 			$r->print(&Apache::lonlocal::locallocaltime($value));
                   3396: 		    } else {
                   3397: 			$r->print($value);
                   3398: 		    }
                   3399: 		    if ($value ne $all[$level]) {
                   3400: 			$r->print('<br /><font color="red">'.&mt('Not active anymore').'</font>');
                   3401: 		    } else {
                   3402: 			$stillactive=1;
                   3403: 		    }
1.290     www      3404: 		}
1.288     albertel 3405: 	    }
1.291     www      3406: 	    $r->print('</td>');
                   3407: 	    if ($stillactive) {
1.292     www      3408: 		if (($uname) && ($udom)) {
                   3409: 		    $r->print('<td>Notify Link</td>');
                   3410: 		} else {
                   3411: 		    $r->print('<td>Blog Link</td>');
                   3412: 		}
1.291     www      3413: 	    } else {
                   3414: 		$r->print('<td>&nbsp;</td>');
                   3415: 	    }
                   3416: 	    $r->print('</tr>');
1.288     albertel 3417: 	}
1.286     www      3418:     }
                   3419:     $r->print('</table>');
1.284     www      3420:     $r->print(&Apache::loncommon::end_page());
                   3421: }
                   3422: 
1.178     raeburn  3423: ##################################################
                   3424: ##################################################
1.30      www      3425: 
1.59      matthew  3426: =pod
                   3427: 
1.83      bowersj2 3428: =item * handler
1.59      matthew  3429: 
                   3430: Main handler.  Calls &assessparms and &crsenv subroutines.
                   3431: 
                   3432: =cut
                   3433: ##################################################
                   3434: ##################################################
1.220     www      3435: #    use Data::Dumper;
                   3436: 
1.259     banghart 3437: 
1.30      www      3438: sub handler {
1.43      albertel 3439:     my $r=shift;
1.30      www      3440: 
1.43      albertel 3441:     if ($r->header_only) {
1.126     www      3442: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 3443: 	$r->send_http_header;
                   3444: 	return OK;
                   3445:     }
1.193     albertel 3446:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205     www      3447: 					    ['action','state',
                   3448:                                              'pres_marker',
                   3449:                                              'pres_value',
1.206     www      3450:                                              'pres_type',
1.243     banghart 3451:                                              'udom','uname','symb','serial']);
1.131     www      3452: 
1.83      bowersj2 3453: 
1.193     albertel 3454:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 3455:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
                   3456: 					    text=>"Parameter Manager",
1.204     www      3457: 					    faq=>10,
1.194     albertel 3458: 					    bug=>'Instructor Interface'});
1.203     www      3459: 
1.30      www      3460: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 3461:     my $parm_permission =
                   3462: 	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190     albertel 3463: 	 &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193     albertel 3464: 				  $env{'request.course.sec'}));
1.194     albertel 3465:     if ($env{'request.course.id'} &&  $parm_permission) {
1.193     albertel 3466: 
                   3467:         # Start Page
1.126     www      3468:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      3469:         $r->send_http_header;
1.30      www      3470: 
1.203     www      3471: 
                   3472:         # id numbers can change on re-ordering of folders
                   3473: 
                   3474:         &resetsymbcache();
                   3475: 
1.193     albertel 3476:         #
                   3477:         # Main switch on form.action and form.state, as appropriate
                   3478:         #
                   3479:         # Check first if coming from someone else headed directly for
                   3480:         #  the table mode
                   3481:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   3482: 	     && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   3483: 	    &assessparms($r);
                   3484: 
                   3485:         } elsif (! exists($env{'form.action'})) {
                   3486:             $r->print(&header());
1.298     albertel 3487:             $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Manager'));
1.193     albertel 3488:             &print_main_menu($r,$parm_permission);
                   3489:         } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) {
1.194     albertel 3490:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv',
                   3491: 						    text=>"Course Environment"});
1.193     albertel 3492:             &crsenv($r); 
                   3493:         } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194     albertel 3494:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3495: 						    text=>"Overview Mode"});
1.121     www      3496: 	    &overview($r);
1.259     banghart 3497:         } elsif ($env{'form.action'} eq 'setrestrictmeta' && $parm_permission) {
                   3498:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
                   3499: 						    text=>"Restrict Metadata"});
                   3500: 	    &setrestrictmeta($r);
1.208     www      3501:         } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) {
                   3502:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3503: 						    text=>"Overview Mode"});
                   3504: 	    &newoverview($r);
1.220     www      3505:         }  elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) {
                   3506:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
                   3507: 						    text=>"Set Defaults"});
                   3508: 	    &defaultsetter($r);
                   3509: 	} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194     albertel 3510:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.204     www      3511: 						    text=>"Table Mode",
                   3512: 						    help => 'Course_Setting_Parameters'});
1.121     www      3513: 	    &assessparms($r);
1.284     www      3514:         } elsif ($env{'form.action'} eq 'parameterchangelog' && $parm_permission) {
                   3515:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.292     www      3516: 						    text=>"Parameter Change Log"});
1.285     albertel 3517: 	    &parm_change_log($r);
1.284     www      3518: 	}       
1.43      albertel 3519:     } else {
1.1       www      3520: # ----------------------------- Not in a course, or not allowed to modify parms
1.190     albertel 3521: 	$env{'user.error.msg'}=
1.43      albertel 3522: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   3523: 	return HTTP_NOT_ACCEPTABLE;
                   3524:     }
                   3525:     return OK;
1.1       www      3526: }
                   3527: 
                   3528: 1;
                   3529: __END__
                   3530: 
1.59      matthew  3531: =pod
1.38      harris41 3532: 
                   3533: =back
                   3534: 
                   3535: =cut
1.1       www      3536: 
                   3537: 
                   3538: 

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