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

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

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