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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.271   ! www         4: # $Id: lonparmset.pm,v 1.270 2005/11/22 16:36:05 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.180     albertel 1608: 			my $title=&Apache::lonnet::gettitle($uri);
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('".
                   1615: 				  &Apache::lonnet::clutter($uri).
1.57      albertel 1616:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127     albertel 1617:                              " TARGET=_self>$title");
1.57      albertel 1618: 
                   1619:                         if ($thistitle) {
                   1620:                             $r->print(' ('.$thistitle.')');
                   1621:                         }
                   1622:                         $r->print('</a></b></td>');
                   1623:                         $r->print('<td bgcolor='.$defbgtwo.
                   1624:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   1625:                                       '</td>');
                   1626: 
                   1627:                         $r->print('<td bgcolor='.$defbgone.
                   1628:                                       ' rowspan='.$totalparms.
1.238     www      1629:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.57      albertel 1630: 
1.236     albertel 1631:                         foreach (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 1632:                             unless ($firstrow) {
                   1633:                                 $r->print('<tr>');
                   1634:                             } else {
                   1635:                                 undef $firstrow;
                   1636:                             }
1.201     www      1637:                             &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 1638:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  1639:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
                   1640:                                                                       $cgroup);
1.57      albertel 1641:                         }
                   1642:                     }
                   1643:                 }
                   1644:             } # end foreach ids
1.43      albertel 1645: # -------------------------------------------------- End entry for one resource
1.57      albertel 1646:             $r->print('</table>');
1.203     www      1647:         } # end of  full
1.57      albertel 1648: #--------------------------------------------------- Entry for parm level map
                   1649:         if ($parmlev eq 'map') {
                   1650:             my $defbgone = '"E0E099"';
                   1651:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1652:             my $defbgthree = '"FFBB99"';
1.57      albertel 1653: 
                   1654:             my %maplist;
                   1655: 
                   1656:             if ($pschp eq 'all') {
                   1657:                 %maplist = %allmaps; 
                   1658:             } else {
                   1659:                 %maplist = ($pschp => $mapp{$pschp});
                   1660:             }
                   1661: 
                   1662: #-------------------------------------------- for each map, gather information
                   1663:             my $mapid;
1.60      albertel 1664: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   1665:                 my $maptitle = $maplist{$mapid};
1.57      albertel 1666: 
                   1667: #-----------------------  loop through ids and get all parameter types for map
                   1668: #-----------------------------------------          and associated information
                   1669:                 my %name = ();
                   1670:                 my %part = ();
                   1671:                 my %display = ();
                   1672:                 my %type = ();
                   1673:                 my %default = ();
                   1674:                 my $map = 0;
                   1675: 
                   1676: #		$r->print("Catmarker: @catmarker<br />\n");
                   1677:                
                   1678:                 foreach (@ids) {
                   1679:                   ($map)=(/([\d]*?)\./);
                   1680:                   my $rid = $_;
                   1681:         
                   1682: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   1683: 
                   1684:                   if ($map eq $mapid) {
1.196     www      1685:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1686: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   1687: 
                   1688: #--------------------------------------------------------------------
                   1689: # @catmarker contains list of all possible parameters including part #s
                   1690: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1691: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1692: # When storing information, store as part 0
                   1693: # When requesting information, request from full part
                   1694: #-------------------------------------------------------------------
1.210     www      1695:                     foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1696:                       my $tempkeyp = $_;
                   1697:                       my $fullkeyp = $tempkeyp;
1.73      albertel 1698:                       $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1699:                       
                   1700:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1701:                         $part{$tempkeyp}="0";
                   1702:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1703:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1704:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1705:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1706:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1707:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1708:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1709:                       }
                   1710:                     } # end loop through keys
                   1711:                   }
                   1712:                 } # end loop through ids
                   1713:                                  
                   1714: #---------------------------------------------------- print header information
1.133     www      1715:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      1716:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57      albertel 1717:                 $r->print(<<ENDMAPONE);
                   1718: <center><h4>
1.135     albertel 1719: Set Defaults for All Resources in $foldermap<br />
                   1720: <font color="red"><i>$showtitle</i></font><br />
1.57      albertel 1721: Specifically for
                   1722: ENDMAPONE
                   1723:                 if ($uname) {
1.267     albertel 1724: 		    my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1725:                     $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130     www      1726:                         &mt('in')." \n");
1.57      albertel 1727:                 } else {
1.135     albertel 1728:                     $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57      albertel 1729:                 }
1.269     raeburn  1730:                 if ($cgroup) {
                   1731:                     $r->print(&mt("Group")." <font color=\"red\"><i>$cgroup".
                   1732:                               "</i></font> ".&mt('of')." \n");
                   1733:                     $csec = '';
                   1734:                 } elsif ($csec) {
                   1735:                     $r->print(&mt("Section")." <font color=\"red\"><i>$csec".
                   1736:                               "</i></font> ".&mt('of')." \n");
                   1737:                 }
1.135     albertel 1738:                 $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
                   1739:                 $r->print("</h4>\n");
1.57      albertel 1740: #---------------------------------------------------------------- print table
                   1741:                 $r->print('<p><table border="2">');
1.130     www      1742:                 $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1743:                 $r->print('<th>'.&mt('Default Value').'</th>');
                   1744:                 $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1745: 
1.210     www      1746: 	        foreach (&keysinorder(\%name,\%keyorder)) {
1.168     matthew  1747:                     $r->print('<tr>');
1.201     www      1748:                     &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  1749:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   1750:                            $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 1751:                 }
                   1752:                 $r->print("</table></center>");
                   1753:             } # end each map
                   1754:         } # end of $parmlev eq map
                   1755: #--------------------------------- Entry for parm level general (Course level)
                   1756:         if ($parmlev eq 'general') {
                   1757:             my $defbgone = '"E0E099"';
                   1758:             my $defbgtwo = '"FFFF99"';
1.269     raeburn  1759:             my $defbgthree = '"FFBB99"';
1.57      albertel 1760: 
                   1761: #-------------------------------------------- for each map, gather information
                   1762:             my $mapid="0.0";
                   1763: #-----------------------  loop through ids and get all parameter types for map
                   1764: #-----------------------------------------          and associated information
                   1765:             my %name = ();
                   1766:             my %part = ();
                   1767:             my %display = ();
                   1768:             my %type = ();
                   1769:             my %default = ();
                   1770:                
                   1771:             foreach (@ids) {
                   1772:                 my $rid = $_;
                   1773:         
1.196     www      1774:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 1775: 
                   1776: #--------------------------------------------------------------------
                   1777: # @catmarker contains list of all possible parameters including part #s
                   1778: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1779: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1780: # When storing information, store as part 0
                   1781: # When requesting information, request from full part
                   1782: #-------------------------------------------------------------------
1.210     www      1783:                 foreach (&keysplit($keyp{$rid})) {
1.57      albertel 1784:                   my $tempkeyp = $_;
                   1785:                   my $fullkeyp = $tempkeyp;
1.73      albertel 1786:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1787:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1788:                     $part{$tempkeyp}="0";
                   1789:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1790:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1791:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1792:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1793:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1794:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1795:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1796:                   }
                   1797:                 } # end loop through keys
                   1798:             } # end loop through ids
                   1799:                                  
                   1800: #---------------------------------------------------- print header information
1.133     www      1801: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 1802:             $r->print(<<ENDMAPONE);
1.133     www      1803: <center><h4>$setdef
1.135     albertel 1804: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 1805: ENDMAPONE
                   1806:             if ($uname) {
1.267     albertel 1807: 		my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 1808:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 1809:             } else {
1.135     albertel 1810:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 1811:             }
                   1812:             
1.135     albertel 1813:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.269     raeburn  1814:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.135     albertel 1815:             $r->print("</h4>\n");
1.57      albertel 1816: #---------------------------------------------------------------- print table
                   1817:             $r->print('<p><table border="2">');
1.130     www      1818:             $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1819:             $r->print('<th>'.&mt('Default Value').'</th>');
                   1820:             $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1821: 
1.210     www      1822: 	    foreach (&keysinorder(\%name,\%keyorder)) {
1.168     matthew  1823:                 $r->print('<tr>');
1.201     www      1824:                 &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  1825:                        \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   1826:                                    $parmlev,$uname,$udom,$csec,$cgroup);
1.57      albertel 1827:             }
                   1828:             $r->print("</table></center>");
                   1829:         } # end of $parmlev eq general
1.43      albertel 1830:     }
1.44      albertel 1831:     $r->print('</form></body></html>');
1.57      albertel 1832: } # end sub assessparms
1.30      www      1833: 
1.59      matthew  1834: 
                   1835: ##################################################
                   1836: ##################################################
                   1837: 
                   1838: =pod
                   1839: 
                   1840: =item crsenv
                   1841: 
1.105     matthew  1842: Show and set course data and parameters.  This is a large routine that should
1.59      matthew  1843: be simplified and shortened... someday.
                   1844: 
                   1845: Inputs: $r
                   1846: 
                   1847: Returns: nothing
                   1848: 
                   1849: =cut
                   1850: 
                   1851: ##################################################
                   1852: ##################################################
1.30      www      1853: sub crsenv {
                   1854:     my $r=shift;
                   1855:     my $setoutput='';
1.64      www      1856:     my $bodytag=&Apache::loncommon::bodytag(
                   1857:                              'Set Course Environment Parameters');
1.194     albertel 1858:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,
                   1859: 						    'Edit Course Environment');
1.190     albertel 1860:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   1861:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.105     matthew  1862: 
                   1863:     #
                   1864:     # Go through list of changes
1.190     albertel 1865:     foreach (keys %env) {
1.105     matthew  1866:         next if ($_!~/^form\.(.+)\_setparmval$/);
                   1867:         my $name  = $1;
1.190     albertel 1868:         my $value = $env{'form.'.$name.'_value'};
1.105     matthew  1869:         if ($name eq 'newp') {
1.190     albertel 1870:             $name = $env{'form.newp_name'};
1.105     matthew  1871:         }
                   1872:         if ($name eq 'url') {
                   1873:             $value=~s/^\/res\///;
                   1874:             my $bkuptime=time;
                   1875:             my @tmp = &Apache::lonnet::get
                   1876:                 ('environment',['url'],$dom,$crs);
1.130     www      1877:             $setoutput.=&mt('Backing up previous URL').': '.
1.105     matthew  1878:                 &Apache::lonnet::put
                   1879:                 ('environment',
                   1880:                  {'top level map backup '.$bkuptime => $tmp[1] },
                   1881:                  $dom,$crs).
                   1882:                      '<br>';
                   1883:         }
                   1884:         #
                   1885:         # Deal with modified default spreadsheets
                   1886:         if ($name =~ /^spreadsheet_default_(classcalc|
                   1887:                                             studentcalc|
                   1888:                                             assesscalc)$/x) {
                   1889:             my $sheettype = $1; 
                   1890:             if ($sheettype eq 'classcalc') {
                   1891:                 # no need to do anything since viewing the sheet will
                   1892:                 # cause it to be updated. 
                   1893:             } elsif ($sheettype eq 'studentcalc') {
                   1894:                 # expire all the student spreadsheets
                   1895:                 &Apache::lonnet::expirespread('','','studentcalc');
                   1896:             } else {
                   1897:                 # expire all the assessment spreadsheets 
                   1898:                 #    this includes non-default spreadsheets, but better to
                   1899:                 #    be safe than sorry.
                   1900:                 &Apache::lonnet::expirespread('','','assesscalc');
                   1901:                 # expire all the student spreadsheets
                   1902:                 &Apache::lonnet::expirespread('','','studentcalc');
1.30      www      1903:             }
1.105     matthew  1904:         }
                   1905:         #
1.107     matthew  1906:         # Deal with the enrollment dates
                   1907:         if ($name =~ /^default_enrollment_(start|end)_date$/) {
                   1908:             $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
                   1909:         }
1.178     raeburn  1910:         # Get existing cloners
                   1911:         my @oldcloner = ();
                   1912:         if ($name eq 'cloners') {
                   1913:             my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
                   1914:             if ($clonenames{'cloners'} =~ /,/) {
                   1915:                 @oldcloner = split/,/,$clonenames{'cloners'};
                   1916:             } else {
                   1917:                 $oldcloner[0] = $clonenames{'cloners'};
                   1918:             }
                   1919:         }
1.107     matthew  1920:         #
1.105     matthew  1921:         # Let the user know we made the changes
1.153     albertel 1922:         if ($name && defined($value)) {
1.239     raeburn  1923:             my $failed_cloners;
1.178     raeburn  1924:             if ($name eq 'cloners') {
1.239     raeburn  1925:                 $value =~ s/\s//g;
1.178     raeburn  1926:                 $value =~ s/^,//;
                   1927:                 $value =~ s/,$//;
1.239     raeburn  1928:                 # check requested clones are valid users.
                   1929:                 $failed_cloners = &check_cloners(\$value,\@oldcloner);
1.178     raeburn  1930:             }
1.105     matthew  1931:             my $put_result = &Apache::lonnet::put('environment',
                   1932:                                                   {$name=>$value},$dom,$crs);
                   1933:             if ($put_result eq 'ok') {
1.130     www      1934:                 $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178     raeburn  1935:                 if ($name eq 'cloners') {
                   1936:                     &change_clone($value,\@oldcloner);
                   1937:                 }
1.179     raeburn  1938:                 # Flush the course logs so course description is immediately updated
                   1939:                 if ($name eq 'description' && defined($value)) {
                   1940:                     &Apache::lonnet::flushcourselogs();
                   1941:                 }
1.105     matthew  1942:             } else {
1.130     www      1943:                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
                   1944: 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30      www      1945:             }
1.239     raeburn  1946:             if (($name eq 'cloners') && ($failed_cloners)) {
                   1947:                 $setoutput.= &mt('Unable to include').' - <b>'.$failed_cloners.'</b>, '.
                   1948:                  &mt('reason').' - '.&mt('LON-CAPA user(s) do(es) not exist').
                   1949:                  '.<br />'.&mt('Please ').
                   1950:                  ' <a href="/adm/createuser">'.
                   1951:                  &mt('add the user(s)').'</a>, '.
                   1952:                  &mt('and then return to the ').
                   1953:                  '<a href="/admparmset?action=crsenv">'.
                   1954:                  &mt('Course Parameters page').'</a> '.
                   1955:                  &mt('to add the new user(s) to the list of possible cloners').
                   1956:                  '.<br />';
                   1957:             }
1.30      www      1958:         }
1.38      harris41 1959:     }
1.108     www      1960: # ------------------------- Re-init course environment entries for this session
                   1961: 
1.190     albertel 1962:     &Apache::lonnet::coursedescription($env{'request.course.id'});
1.105     matthew  1963: 
1.30      www      1964: # -------------------------------------------------------- Get parameters again
1.45      matthew  1965: 
                   1966:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140     sakharuk 1967:     my $SelectStyleFile=&mt('Select Style File');
1.141     sakharuk 1968:     my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30      www      1969:     my $output='';
1.45      matthew  1970:     if (! exists($values{'con_lost'})) {
1.30      www      1971:         my %descriptions=
1.140     sakharuk 1972: 	    ('url'            => '<b>'.&mt('Top Level Map').'</b> '.
1.46      matthew  1973:                                  '<a href="javascript:openbrowser'.
1.47      matthew  1974:                                  "('envform','url','sequence')\">".
1.140     sakharuk 1975:                                  &mt('Select Map').'</a><br /><font color=red> '.
                   1976:                                  &mt('Modification may make assessment data inaccessible').
                   1977:                                  '</font>',
                   1978:              'description'    => '<b>'.&mt('Course Description').'</b>',
1.158     sakharuk 1979:              'courseid'       => '<b>'.&mt('Course ID or number').
1.140     sakharuk 1980:                                  '</b><br />'.
                   1981:                                  '('.&mt('internal').', '.&mt('optional').')',
1.177     raeburn  1982:              '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      1983:              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                   1984:                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140     sakharuk 1985:              'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52      www      1986:                     '<a href="javascript:openbrowser'.
                   1987:                     "('envform','default_xml_style'".
1.140     sakharuk 1988:                     ",'sty')\">$SelectStyleFile</a><br>",
1.141     sakharuk 1989:              'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
                   1990:                                  '</b><br />(<tt>user:domain,'.
1.74      www      1991:                                  'user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1992:              'comment.email'  => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74      www      1993:                                  '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1994:              'policy.email'   => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75      albertel 1995:                                  '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1996:              'hideemptyrows'  => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158     sakharuk 1997:                                  '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141     sakharuk 1998:              'pageseparators'  => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158     sakharuk 1999:                                  '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141     sakharuk 2000:                                  &mt('changes will not show until next login').')',
1.169     matthew  2001:              '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  2002: 
1.141     sakharuk 2003:              'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
                   2004:                                   '</b><br />"<tt>st</tt>": '.
1.158     sakharuk 2005:                                   &mt('student').', "<tt>ta</tt>": '.
1.118     matthew  2006:                                   'TA, "<tt>in</tt>": '.
1.158     sakharuk 2007:                                   &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118     matthew  2008: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                   2009:              'plc.users.denied' => 
1.141     sakharuk 2010:                           '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118     matthew  2011:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   2012: 
1.141     sakharuk 2013:              'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
                   2014:                                   '</b><br />"<tt>st</tt>": '.
1.61      albertel 2015:                                   'student, "<tt>ta</tt>": '.
                   2016:                                   'TA, "<tt>in</tt>": '.
1.75      albertel 2017:                                   'instructor;<br /><tt>role,role,...</tt>) '.
1.61      albertel 2018: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53      www      2019:              'pch.users.denied' => 
1.141     sakharuk 2020:                           '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53      www      2021:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  2022:              'spreadsheet_default_classcalc' 
1.141     sakharuk 2023:                  => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50      matthew  2024:                     '<a href="javascript:openbrowser'.
                   2025:                     "('envform','spreadsheet_default_classcalc'".
1.141     sakharuk 2026:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2027:              'spreadsheet_default_studentcalc' 
1.141     sakharuk 2028:                  => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50      matthew  2029:                     '<a href="javascript:openbrowser'.
                   2030:                     "('envform','spreadsheet_default_calc'".
1.141     sakharuk 2031:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  2032:              'spreadsheet_default_assesscalc' 
1.141     sakharuk 2033:                  => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50      matthew  2034:                     '<a href="javascript:openbrowser'.
                   2035:                     "('envform','spreadsheet_default_assesscalc'".
1.141     sakharuk 2036:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75      albertel 2037: 	     'allow_limited_html_in_feedback'
1.141     sakharuk 2038: 	         => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158     sakharuk 2039: 	            '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170     raeburn  2040:              'allow_discussion_post_editing'
                   2041:                  => '<b>'.&mt('Allow users to edit/delete their own discussion posts').'</b><br />'.
                   2042:                     '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.89      albertel 2043: 	     'rndseed'
1.140     sakharuk 2044: 	         => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
                   2045:                     '<font color="red">'.&mt('Modifying this will make problems').' '.
                   2046:                     &mt('have different numbers and answers').'</font>',
1.151     albertel 2047: 	     'receiptalg'
                   2048: 	         => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
                   2049:                     &mt('This controls how receipt numbers are generated.'),
1.164     sakharuk 2050:              'suppress_tries'
                   2051:                  => '<b>'.&mt('Suppress number of tries in printing').'</b>('.
                   2052:                     &mt('yes if supress').')',
1.113     sakharuk 2053:              'problem_stream_switch'
1.141     sakharuk 2054:                  => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158     sakharuk 2055:                     ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161     sakharuk 2056:              'default_paper_size' 
                   2057:                  => '<b>'.&mt('Default paper type').'</b><br />'.
                   2058:                     ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'. 
                   2059:                     ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'. 
                   2060:                     ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111     sakharuk 2061:              'anonymous_quiz'
1.150     www      2062:                  => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141     sakharuk 2063:                     ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
1.217     albertel 2064:              'default_enrollment_start_date' => '<b>'.&mt('Default beginning date for student access.').'</b>',
                   2065:              'default_enrollment_end_date'   => '<b>'.&mt('Default ending date for student access.').'</b>',
1.150     www      2066:              'nothideprivileged'   => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
                   2067:                                  '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140     sakharuk 2068:              'languages' => '<b>'.&mt('Languages used').'</b>',
1.115     www      2069:              'disable_receipt_display'
1.141     sakharuk 2070:                  => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158     sakharuk 2071:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163     albertel 2072: 	     'disablesigfigs'
                   2073: 	         => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
                   2074:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.251     albertel 2075: 	     'disableexampointprint'
                   2076: 	         => '<b>'.&mt('Disable automatically printing point values onto exams.').'</b><br />'.
                   2077:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.149     albertel 2078: 	     'tthoptions'
                   2079: 	         => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107     matthew  2080:              ); 
1.177     raeburn  2081:         my @Display_Order = ('url','description','courseid','cloners','grading',
1.107     matthew  2082:                              'default_xml_style','pageseparators',
                   2083:                              'question.email','comment.email','policy.email',
1.169     matthew  2084:                              'student_classlist_view',
1.118     matthew  2085:                              'plc.roles.denied','plc.users.denied',
1.107     matthew  2086:                              'pch.roles.denied','pch.users.denied',
                   2087:                              'allow_limited_html_in_feedback',
1.170     raeburn  2088:                              'allow_discussion_post_editing',
1.108     www      2089:                              'languages',
1.150     www      2090: 			     'nothideprivileged',
1.107     matthew  2091:                              'rndseed',
1.151     albertel 2092:                              'receiptalg',
1.107     matthew  2093:                              'problem_stream_switch',
1.164     sakharuk 2094: 			     'suppress_tries',
1.161     sakharuk 2095:                              'default_paper_size',
1.115     www      2096:                              'disable_receipt_display',
1.107     matthew  2097:                              'spreadsheet_default_classcalc',
                   2098:                              'spreadsheet_default_studentcalc',
                   2099:                              'spreadsheet_default_assesscalc', 
                   2100:                              'hideemptyrows',
                   2101:                              'default_enrollment_start_date',
                   2102:                              'default_enrollment_end_date',
1.163     albertel 2103: 			     'tthoptions',
1.251     albertel 2104: 			     'disablesigfigs',
                   2105: 			     'disableexampointprint'
1.107     matthew  2106:                              );
                   2107: 	foreach my $parameter (sort(keys(%values))) {
1.244     banghart 2108:             unless (($parameter =~ m/^internal\./)||($parameter =~ m/^metadata\./)) {
1.142     raeburn  2109:                 if (! $descriptions{$parameter}) {
                   2110:                     $descriptions{$parameter}=$parameter;
                   2111:                     push(@Display_Order,$parameter);
                   2112:                 }
                   2113:             }
1.43      albertel 2114: 	}
1.107     matthew  2115:         foreach my $parameter (@Display_Order) {
                   2116:             my $description = $descriptions{$parameter};
1.51      matthew  2117:             # onchange is javascript to automatically check the 'Set' button.
1.69      www      2118:             my $onchange = 'onFocus="javascript:window.document.forms'.
1.107     matthew  2119:                 "['envform'].elements['".$parameter."_setparmval']".
1.51      matthew  2120:                 '.checked=true;"';
1.107     matthew  2121:             $output .= '<tr><td>'.$description.'</td>';
                   2122:             if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
                   2123:                 $output .= '<td>'.
                   2124:                     &Apache::lonhtmlcommon::date_setter('envform',
                   2125:                                                         $parameter.'_value',
                   2126:                                                         $values{$parameter},
                   2127:                                                         $onchange).
                   2128:                                                         '</td>';
                   2129:             } else {
                   2130:                 $output .= '<td>'.
                   2131:                     &Apache::lonhtmlcommon::textbox($parameter.'_value',
                   2132:                                                     $values{$parameter},
                   2133:                                                     40,$onchange).'</td>';
                   2134:             }
                   2135:             $output .= '<td>'.
                   2136:                 &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                   2137:                 '</td>';
                   2138:             $output .= "</tr>\n";
1.51      matthew  2139: 	}
1.69      www      2140:         my $onchange = 'onFocus="javascript:window.document.forms'.
1.51      matthew  2141:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   2142:             '.checked=true;"';
1.130     www      2143: 	$output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51      matthew  2144: 	    '<input type="text" size=40 name="newp_name" '.
                   2145:                 $onchange.' /></td><td>'.
                   2146:             '<input type="text" size=40 name="newp_value" '.
                   2147:                 $onchange.' /></td><td>'.
                   2148: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 2149:     }
1.157     sakharuk 2150:     my %lt=&Apache::lonlocal::texthash(
                   2151: 		    'par'   => 'Parameter',
                   2152: 		    'val'   => 'Value',
                   2153: 		    'set'   => 'Set',
                   2154: 		    'sce'   => 'Set Course Environment'
                   2155: 				       );
                   2156: 
1.140     sakharuk 2157:     my $Parameter=&mt('Parameter');
                   2158:     my $Value=&mt('Value');
1.141     sakharuk 2159:     my $Set=&mt('Set');
1.167     albertel 2160:     my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset');
1.183     albertel 2161:     my $html=&Apache::lonxml::xmlbegin();
1.190     albertel 2162:     $r->print(<<ENDenv);
1.183     albertel 2163: $html
                   2164: <head>
1.46      matthew  2165: <script type="text/javascript" language="Javascript" >
1.155     albertel 2166: $browse_js
1.46      matthew  2167: </script>
1.30      www      2168: <title>LON-CAPA Course Environment</title>
                   2169: </head>
1.64      www      2170: $bodytag
1.193     albertel 2171: $breadcrumbs
                   2172: <form method="post" action="/adm/parmset?action=crsenv" name="envform">
1.30      www      2173: $setoutput
                   2174: <p>
                   2175: <table border=2>
1.157     sakharuk 2176: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30      www      2177: $output
                   2178: </table>
1.157     sakharuk 2179: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30      www      2180: </form>
                   2181: </body>
                   2182: </html>    
1.190     albertel 2183: ENDenv
1.30      www      2184: }
1.120     www      2185: ##################################################
1.207     www      2186: # Overview mode
                   2187: ##################################################
1.124     www      2188: my $tableopen;
                   2189: 
                   2190: sub tablestart {
                   2191:     if ($tableopen) {
                   2192: 	return '';
                   2193:     } else {
                   2194: 	$tableopen=1;
1.130     www      2195: 	return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
                   2196: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      2197:     }
                   2198: }
                   2199: 
                   2200: sub tableend {
                   2201:     if ($tableopen) {
                   2202: 	$tableopen=0;
                   2203: 	return '</table>';
                   2204:     } else {
                   2205: 	return'';
                   2206:     }
                   2207: }
                   2208: 
1.207     www      2209: sub readdata {
                   2210:     my ($crs,$dom)=@_;
                   2211: # Read coursedata
                   2212:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   2213: # Read userdata
                   2214: 
                   2215:     my $classlist=&Apache::loncoursedata::get_classlist();
                   2216:     foreach (keys %$classlist) {
                   2217:         # the following undefs are for 'domain', and 'username' respectively.
                   2218:         if ($_=~/^(\w+)\:(\w+)$/) {
                   2219: 	    my ($tuname,$tudom)=($1,$2);
                   2220: 	    my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   2221:             foreach my $userkey (keys %{$useropt}) {
                   2222: 		if ($userkey=~/^$env{'request.course.id'}/) {
                   2223:                     my $newkey=$userkey;
                   2224: 		    $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   2225: 		    $$resourcedata{$newkey}=$$useropt{$userkey};
                   2226: 		}
                   2227: 	    }
                   2228: 	}
                   2229:     }
                   2230:     return $resourcedata;
                   2231: }
                   2232: 
                   2233: 
1.124     www      2234: # Setting
1.208     www      2235: 
                   2236: sub storedata {
                   2237:     my ($r,$crs,$dom)=@_;
1.207     www      2238: # Set userlevel immediately
                   2239: # Do an intermediate store of course level
                   2240:     my $olddata=&readdata($crs,$dom);
1.124     www      2241:     my %newdata=();
                   2242:     undef %newdata;
                   2243:     my @deldata=();
                   2244:     undef @deldata;
1.190     albertel 2245:     foreach (keys %env) {
1.124     www      2246: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   2247: 	    my $cmd=$1;
                   2248: 	    my $thiskey=$2;
1.207     www      2249: 	    my ($tuname,$tudom)=&extractuser($thiskey);
                   2250: 	    my $tkey=$thiskey;
                   2251:             if ($tuname) {
                   2252: 		$tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   2253: 	    }
1.124     www      2254: 	    if ($cmd eq 'set') {
1.190     albertel 2255: 		my $data=$env{$_};
1.212     www      2256:                 my $typeof=$env{'form.typeof_'.$thiskey};
                   2257:  		if ($$olddata{$thiskey} ne $data) { 
1.207     www      2258: 		    if ($tuname) {
1.212     www      2259: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2260: 								 $tkey.'.type' => $typeof},
                   2261: 						 $tudom,$tuname) eq 'ok') {
1.207     www      2262: 			    $r->print('<br />'.&mt('Stored modified parameter for').' '.
                   2263: 				      &Apache::loncommon::plainname($tuname,$tudom));
                   2264: 			} else {
                   2265: 			    $r->print('<h2><font color="red">'.
                   2266: 				      &mt('Error storing parameters').'</font></h2>');
                   2267: 			}
                   2268: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2269: 		    } else {
                   2270: 			$newdata{$thiskey}=$data;
1.212     www      2271:  			$newdata{$thiskey.'.type'}=$typeof; 
                   2272:                    } 
1.207     www      2273: 		}
1.124     www      2274: 	    } elsif ($cmd eq 'del') {
1.207     www      2275: 		if ($tuname) {
                   2276: 		    if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
                   2277: 			$r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2278: 		    } else {
                   2279: 			$r->print('<h2><font color="red">'.
                   2280: 				  &mt('Error deleting parameters').'</font></h2>');
                   2281: 		    }
                   2282: 		    &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2283: 		} else {
                   2284: 		    push (@deldata,$thiskey);
                   2285: 		}
1.124     www      2286: 	    } elsif ($cmd eq 'datepointer') {
1.190     albertel 2287: 		my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
1.212     www      2288:                 my $typeof=$env{'form.typeof_'.$thiskey};
1.207     www      2289: 		if (defined($data) and $$olddata{$thiskey} ne $data) { 
                   2290: 		    if ($tuname) {
1.212     www      2291: 			if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
                   2292: 								 $tkey.'.type' => $typeof},
                   2293: 						 $tudom,$tuname) eq 'ok') {
1.207     www      2294: 			    $r->print('<br />'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   2295: 			} else {
                   2296: 			    $r->print('<h2><font color="red">'.
                   2297: 				      &mt('Error storing parameters').'</font></h2>');
                   2298: 			}
                   2299: 			&Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   2300: 		    } else {
1.212     www      2301: 			$newdata{$thiskey}=$data;
                   2302: 			$newdata{$thiskey.'.type'}=$typeof; 
1.207     www      2303: 		    }
                   2304: 		}
1.124     www      2305: 	    }
                   2306: 	}
                   2307:     }
1.207     www      2308: # Store all course level
1.144     www      2309:     my $delentries=$#deldata+1;
                   2310:     my @newdatakeys=keys %newdata;
                   2311:     my $putentries=$#newdatakeys+1;
                   2312:     if ($delentries) {
                   2313: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   2314: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   2315: 	} else {
                   2316: 	    $r->print('<h2><font color="red">'.
                   2317: 		      &mt('Error deleting parameters').'</font></h2>');
                   2318: 	}
1.205     www      2319: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2320:     }
                   2321:     if ($putentries) {
                   2322: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1.212     www      2323: 	    $r->print('<h3>'.&mt('Stored [_1] parameter(s)',$putentries/2).'</h3>');
1.144     www      2324: 	} else {
                   2325: 	    $r->print('<h2><font color="red">'.
                   2326: 		      &mt('Error storing parameters').'</font></h2>');
                   2327: 	}
1.205     www      2328: 	&Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      2329:     }
1.208     www      2330: }
1.207     www      2331: 
1.208     www      2332: sub extractuser {
                   2333:     my $key=shift;
                   2334:     return ($key=~/^$env{'request.course.id'}.\[useropt\:(\w+)\:(\w+)\]\./);
                   2335: }
1.206     www      2336: 
1.208     www      2337: sub listdata {
1.214     www      2338:     my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207     www      2339: # Start list output
1.206     www      2340: 
1.122     www      2341:     my $oldsection='';
                   2342:     my $oldrealm='';
                   2343:     my $oldpart='';
1.123     www      2344:     my $pointer=0;
1.124     www      2345:     $tableopen=0;
1.145     www      2346:     my $foundkeys=0;
1.248     albertel 2347:     my %keyorder=&standardkeyorder();
1.214     www      2348:     foreach my $thiskey (sort {
                   2349: 	if ($sortorder eq 'realmstudent') {
1.247     albertel 2350: 	    my ($astudent,$arealm)=($a=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2351: 	    my ($bstudent,$brealm)=($b=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)\.[^\.]+$/);
                   2352: 	    if (!defined($astudent)) {
                   2353: 		($arealm)=($a=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.237     albertel 2354: 	    }
1.247     albertel 2355: 	    if (!defined($bstudent)) {
                   2356: 		($brealm)=($b=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
                   2357: 	    }
1.248     albertel 2358: 	    $arealm=~s/\.type//;
                   2359: 	    my ($ares, $aparm) = ($arealm=~/^(.*)\.(.*)$/);
                   2360: 	    $aparm=$keyorder{'parameter_0_'.$aparm};
                   2361: 	    $brealm=~s/\.type//;
                   2362: 	    my ($bres, $bparm) = ($brealm=~/^(.*)\.(.*)$/);
                   2363: 	    $bparm=$keyorder{'parameter_0_'.$bparm};	   
                   2364: 	    if ($ares eq $bres) {
                   2365: 		if (defined($aparm) && defined($bparm)) {
                   2366: 		    ($aparm <=> $bparm);
                   2367: 		} elsif (defined($aparm)) {
                   2368: 		    -1;
                   2369: 		} elsif (defined($bparm)) {
                   2370: 		    1;
                   2371: 		} else {
                   2372: 		    ($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2373: 		}
                   2374: 	    } else {
                   2375: 		($arealm cmp $brealm) || ($astudent cmp $bstudent);
                   2376: 	    }
1.214     www      2377: 	} else {
                   2378: 	    $a cmp $b;
                   2379: 	}
                   2380:     } keys %{$listdata}) {
1.247     albertel 2381: 	 
1.211     www      2382: 	if ($$listdata{$thiskey.'.type'}) {
                   2383:             my $thistype=$$listdata{$thiskey.'.type'};
                   2384:             if ($$resourcedata{$thiskey.'.type'}) {
                   2385: 		$thistype=$$resourcedata{$thiskey.'.type'};
                   2386: 	    }
1.207     www      2387: 	    my ($middle,$part,$name)=
                   2388: 		($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      2389: 	    my $section=&mt('All Students');
1.207     www      2390: 	    if ($middle=~/^\[(.*)\]/) {
1.206     www      2391: 		my $issection=$1;
                   2392: 		if ($issection=~/^useropt\:(\w+)\:(\w+)/) {
                   2393: 		    $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
                   2394: 		} else {
                   2395: 		    $section=&mt('Group/Section').': '.$issection;
                   2396: 		}
1.207     www      2397: 		$middle=~s/^\[(.*)\]//;
1.122     www      2398: 	    }
1.207     www      2399: 	    $middle=~s/\.+$//;
                   2400: 	    $middle=~s/^\.+//;
1.130     www      2401: 	    my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122     www      2402: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174     albertel 2403: 		$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122     www      2404: 	    } elsif ($middle) {
1.174     albertel 2405: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   2406: 		$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      2407: 	    }
1.214     www      2408: 	    if ($sortorder eq 'realmstudent') {
                   2409: 		if ($realm ne $oldrealm) {
                   2410: 		    $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   2411: 		    $oldrealm=$realm;
                   2412: 		    $oldsection='';
                   2413: 		}
                   2414: 		if ($section ne $oldsection) {
                   2415: 		    $r->print(&tableend()."\n<h2>$section</h2>");
                   2416: 		    $oldsection=$section;
                   2417: 		    $oldpart='';
                   2418: 		}
                   2419: 	    } else {
                   2420: 		if ($section ne $oldsection) {
                   2421: 		    $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   2422: 		    $oldsection=$section;
                   2423: 		    $oldrealm='';
                   2424: 		}
                   2425: 		if ($realm ne $oldrealm) {
                   2426: 		    $r->print(&tableend()."\n<h2>$realm</h2>");
                   2427: 		    $oldrealm=$realm;
                   2428: 		    $oldpart='';
                   2429: 		}
1.122     www      2430: 	    }
                   2431: 	    if ($part ne $oldpart) {
1.124     www      2432: 		$r->print(&tableend().
1.214     www      2433: 			  "\n<font color='blue'>".&mt('Part').": $part</font>");
1.122     www      2434: 		$oldpart=$part;
                   2435: 	    }
1.123     www      2436: #
1.230     www      2437: # Preset defaults?
                   2438: #
                   2439:             my ($hour,$min,$sec,$val)=('','','','');
                   2440: 	    unless ($$resourcedata{$thiskey}) {
                   2441: 		my ($parmname)=($thiskey=~/\.(\w+)$/);
                   2442: 		($hour,$min,$sec,$val)=&preset_defaults($parmname);
                   2443: 	    }
                   2444: 
                   2445: #
1.123     www      2446: # Ready to print
                   2447: #
1.124     www      2448: 	    $r->print(&tablestart().'<tr><td><b>'.$name.
                   2449: 		      ':</b></td><td><input type="checkbox" name="del_'.
                   2450: 		      $thiskey.'" /></td><td>');
1.145     www      2451: 	    $foundkeys++;
1.213     www      2452: 	    if (&isdateparm($thistype)) {
1.123     www      2453: 		my $jskey='key_'.$pointer;
                   2454: 		$pointer++;
                   2455: 		$r->print(
1.232     albertel 2456: 			  &Apache::lonhtmlcommon::date_setter('parmform',
1.123     www      2457: 							      $jskey,
1.219     www      2458: 						      $$resourcedata{$thiskey},
1.230     www      2459: 							      '',1,'','',$hour,$min,$sec).
1.123     www      2460: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
                   2461: 			  );
1.219     www      2462: 	    } elsif ($thistype eq 'string_yesno') {
1.230     www      2463: 		my $showval;
                   2464: 		if (defined($$resourcedata{$thiskey})) {
                   2465: 		    $showval=$$resourcedata{$thiskey};
                   2466: 		} else {
                   2467: 		    $showval=$val;
                   2468: 		}
1.219     www      2469: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2470: 			  '" value="yes"');
1.230     www      2471: 		if ($showval eq 'yes') {
1.219     www      2472: 		    $r->print(' checked="checked"');
                   2473: 		}
                   2474:                 $r->print(' />'.&mt('Yes').'</label> ');
                   2475: 		$r->print('<label><input type="radio" name="set_'.$thiskey.
                   2476: 			  '" value="no"');
1.230     www      2477: 		if ($showval eq 'no') {
1.219     www      2478: 		    $r->print(' checked="checked"');
                   2479: 		}
                   2480:                 $r->print(' />'.&mt('No').'</label>');
1.123     www      2481: 	    } else {
1.230     www      2482: 		my $showval;
                   2483: 		if (defined($$resourcedata{$thiskey})) {
                   2484: 		    $showval=$$resourcedata{$thiskey};
                   2485: 		} else {
                   2486: 		    $showval=$val;
                   2487: 		}
1.211     www      2488: 		$r->print('<input type="text" name="set_'.$thiskey.'" value="'.
1.230     www      2489: 			  $showval.'">');
1.123     www      2490: 	    }
1.211     www      2491: 	    $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   2492: 		      $thistype.'">');
1.124     www      2493: 	    $r->print('</td></tr>');
1.122     www      2494: 	}
1.121     www      2495:     }
1.208     www      2496:     return $foundkeys;
                   2497: }
                   2498: 
                   2499: sub newoverview {
                   2500:     my $r=shift;
1.216     www      2501:     my $bodytag=&Apache::loncommon::bodytag('Set Parameters');
1.208     www      2502:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2503:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2504:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
                   2505:     my $html=&Apache::lonxml::xmlbegin();
                   2506:     $r->print(<<ENDOVER);
                   2507: $html
                   2508: <head>
                   2509: <title>LON-CAPA Parameters</title>
                   2510: </head>
                   2511: $bodytag
                   2512: $breadcrumbs
1.232     albertel 2513: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208     www      2514: ENDOVER
1.211     www      2515:     my @ids=();
                   2516:     my %typep=();
                   2517:     my %keyp=();
                   2518:     my %allparms=();
                   2519:     my %allparts=();
                   2520:     my %allmaps=();
                   2521:     my %mapp=();
                   2522:     my %symbp=();
                   2523:     my %maptitles=();
                   2524:     my %uris=();
                   2525:     my %keyorder=&standardkeyorder();
                   2526:     my %defkeytype=();
                   2527: 
                   2528:     my %alllevs=();
                   2529:     $alllevs{'Resource Level'}='full';
1.215     www      2530:     $alllevs{'Map/Folder Level'}='map';
1.211     www      2531:     $alllevs{'Course Level'}='general';
                   2532: 
                   2533:     my $csec=$env{'form.csec'};
1.269     raeburn  2534:     my $cgroup=$env{'form.cgroup'};
1.211     www      2535: 
                   2536:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   2537:     my $pschp=$env{'form.pschp'};
                   2538:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
                   2539:     if (!@psprt) { $psprt[0]='0'; }
                   2540: 
                   2541:     my @selected_sections = 
                   2542: 	&Apache::loncommon::get_env_multiple('form.Section');
                   2543:     @selected_sections = ('all') if (! @selected_sections);
                   2544:     foreach (@selected_sections) {
                   2545:         if ($_ eq 'all') {
                   2546:             @selected_sections = ('all');
                   2547:         }
                   2548:     }
1.269     raeburn  2549:     my @selected_groups =
                   2550:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      2551: 
                   2552:     my $pssymb='';
                   2553:     my $parmlev='';
                   2554:  
                   2555:     unless ($env{'form.parmlev'}) {
                   2556:         $parmlev = 'map';
                   2557:     } else {
                   2558:         $parmlev = $env{'form.parmlev'};
                   2559:     }
                   2560: 
                   2561:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   2562: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   2563: 				\%keyorder,\%defkeytype);
                   2564: 
                   2565: # Menu to select levels, etc
                   2566: 
                   2567:     $r->print('<table border="1"><tr><td>');
                   2568:     &levelmenu($r,\%alllevs,$parmlev);
                   2569:     if ($parmlev ne 'general') {
                   2570: 	$r->print('<td>');
                   2571: 	&mapmenu($r,\%allmaps,$pschp,\%maptitles);
                   2572: 	$r->print('</td>');
                   2573:     }
                   2574:     $r->print('</td></tr></table>');
                   2575: 
                   2576:     $r->print('<table border="1"><tr><td>');  
                   2577:     &parmmenu($r,\%allparms,\@pscat,\%keyorder);
1.269     raeburn  2578:     $r->print('</td><td><table border="0" cellspacing="0" cellpadding="0">'.
                   2579:               '<tr><td>'.&mt('Parts').'</td><td></td><td>'.&mt('Section(s)').
                   2580:               '</td><td></td><td>'.&mt('Group(s)').'</td></tr><tr><td>');
1.211     www      2581:     &partmenu($r,\%allparts,\@psprt);
1.269     raeburn  2582:     $r->print('</td><td>&nbsp;</td><td>');
1.211     www      2583:     &sectionmenu($r,\@selected_sections);
1.269     raeburn  2584:     $r->print('</td><td>&nbsp;</td><td>');
                   2585:     &groupmenu($r,\@selected_groups);
                   2586:     $r->print('</td></tr></table>');
1.214     www      2587:     $r->print('</td></tr></table>');
                   2588:  
                   2589:     my $sortorder=$env{'form.sortorder'};
                   2590:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2591:     &sortmenu($r,$sortorder);
                   2592: 
                   2593:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.211     www      2594: 
                   2595: # Build the list data hash from the specified parms
                   2596: 
                   2597:     my $listdata;
                   2598:     %{$listdata}=();
                   2599: 
                   2600:     foreach my $cat (@pscat) {
1.269     raeburn  2601:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   2602:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      2603:     }
                   2604: 
1.212     www      2605:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      2606: 
1.212     www      2607: 	if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      2608: 
                   2609: # Read modified data
                   2610: 
                   2611: 	my $resourcedata=&readdata($crs,$dom);
                   2612: 
                   2613: # List data
                   2614: 
1.214     www      2615: 	&listdata($r,$resourcedata,$listdata,$sortorder);
1.211     www      2616:     }
                   2617:     $r->print(&tableend().
1.212     www      2618: 	     ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Store').'" /></p>':'').
                   2619: 	      '</form></body></html>');
1.208     www      2620: }
                   2621: 
1.269     raeburn  2622: sub secgroup_lister {
                   2623:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   2624:     foreach my $item (@{$selections}) {
                   2625:         foreach my $part (@{$psprt}) {
                   2626:             my $rootparmkey=$env{'request.course.id'};
                   2627:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   2628:                 $rootparmkey.='.['.$item.']';
                   2629:             }
                   2630:             if ($parmlev eq 'general') {
                   2631: # course-level parameter
                   2632:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   2633:                 $$listdata{$newparmkey}=1;
                   2634:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2635:             } elsif ($parmlev eq 'map') {
                   2636: # map-level parameter
                   2637:                 foreach my $mapid (keys %{$allmaps}) {
                   2638:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   2639:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   2640:                     $$listdata{$newparmkey}=1;
                   2641:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2642:                 }
                   2643:             } else {
                   2644: # resource-level parameter
                   2645:                 foreach my $rid (@{$ids}) {
                   2646:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   2647:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   2648:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   2649:                     $$listdata{$newparmkey}=1;
                   2650:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   2651:                 }
                   2652:             }
                   2653:         }
                   2654:     }
                   2655: }
                   2656: 
1.208     www      2657: sub overview {
                   2658:     my $r=shift;
1.216     www      2659:     my $bodytag=&Apache::loncommon::bodytag('Modify Parameters');
1.208     www      2660:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2661:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2662:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
                   2663:     my $html=&Apache::lonxml::xmlbegin();
                   2664:     $r->print(<<ENDOVER);
                   2665: $html
                   2666: <head>
                   2667: <title>LON-CAPA Parameters</title>
                   2668: </head>
                   2669: $bodytag
                   2670: $breadcrumbs
1.232     albertel 2671: <form method="post" action="/adm/parmset?action=setoverview" name="parmform">
1.208     www      2672: ENDOVER
                   2673: # Store modified
                   2674: 
                   2675:     &storedata($r,$crs,$dom);
                   2676: 
                   2677: # Read modified data
                   2678: 
                   2679:     my $resourcedata=&readdata($crs,$dom);
                   2680: 
1.214     www      2681: 
                   2682:     my $sortorder=$env{'form.sortorder'};
                   2683:     unless ($sortorder) { $sortorder='realmstudent'; }
                   2684:     &sortmenu($r,$sortorder);
                   2685: 
1.208     www      2686: # List data
                   2687: 
1.214     www      2688:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208     www      2689: 
1.145     www      2690:     $r->print(&tableend().'<p>'.
1.208     www      2691: 	($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no parameters.')).'</p></form></body></html>');
1.120     www      2692: }
1.121     www      2693: 
1.59      matthew  2694: ##################################################
                   2695: ##################################################
1.178     raeburn  2696:                                                                                             
                   2697: =pod
1.239     raeburn  2698: 
                   2699: =item check_cloners
                   2700: 
                   2701: Checks if new users included in list of allowed cloners
                   2702: are valid users.  Replaces supplied list with 
                   2703: cleaned list containing only users with valid usernames
                   2704: and domains.
                   2705: 
                   2706: Inputs: $clonelist, $oldcloner 
                   2707: where $clonelist is ref to array of requested cloners,
                   2708: and $oldcloner is ref to array of currently allowed
                   2709: cloners.
                   2710: 
                   2711: Returns: string - comma separated list of requested
                   2712: cloners (username:domain) who do not exist in system.
                   2713: 
                   2714: =item change_clone
                   2715: 
1.178     raeburn  2716: Modifies the list of courses a user can clone (stored
1.239     raeburn  2717: in the user's environment.db file), called when a
1.178     raeburn  2718: change is made to the list of users allowed to clone
                   2719: a course.
1.239     raeburn  2720: 
1.178     raeburn  2721: Inputs: $action,$cloner
                   2722: where $action is add or drop, and $cloner is identity of 
                   2723: user for whom cloning ability is to be changed in course. 
                   2724: 
                   2725: =cut
                   2726:                                                                                             
                   2727: ##################################################
                   2728: ##################################################
                   2729: 
1.239     raeburn  2730: sub extract_cloners {
                   2731:     my ($clonelist,$allowclone) = @_;
                   2732:     if ($clonelist =~ /,/) {
                   2733:         @{$allowclone} = split/,/,$clonelist;
                   2734:     } else {
                   2735:         $$allowclone[0] = $clonelist;
                   2736:     }
                   2737: }
                   2738: 
                   2739: 
                   2740: sub check_cloners {
                   2741:     my ($clonelist,$oldcloner) = @_;
                   2742:     my ($clean_clonelist,$disallowed);
                   2743:     my @allowclone = ();
                   2744:     &extract_cloners($$clonelist,\@allowclone);
                   2745:     foreach my $currclone (@allowclone) {
                   2746:         if (!grep/^$currclone$/,@$oldcloner) {
                   2747:             my ($uname,$udom) = split/:/,$currclone;
                   2748:             if ($uname && $udom) {
                   2749:                 if (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2750:                     $disallowed .= $currclone.',';   
                   2751:                 } else {
                   2752:                     $clean_clonelist .= $currclone.',';
                   2753:                 }
                   2754:             }
                   2755:         } else {
                   2756:             $clean_clonelist .= $currclone.',';
                   2757:         }
                   2758:     }
                   2759:     if ($disallowed) {
                   2760:         $disallowed =~ s/,$//;
                   2761:     }
                   2762:     if ($clean_clonelist) {
                   2763:         $clean_clonelist =~ s/,$//;
                   2764:     }
                   2765:     $$clonelist = $clean_clonelist;
                   2766:     return $disallowed;
                   2767: }  
1.178     raeburn  2768: 
                   2769: sub change_clone {
                   2770:     my ($clonelist,$oldcloner) = @_;
                   2771:     my ($uname,$udom);
1.190     albertel 2772:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2773:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178     raeburn  2774:     my $clone_crs = $cnum.':'.$cdom;
                   2775:     
                   2776:     if ($cnum && $cdom) {
1.239     raeburn  2777:         my @allowclone;
                   2778:         &extract_cloners($clonelist,\@allowclone);
1.178     raeburn  2779:         foreach my $currclone (@allowclone) {
                   2780:             if (!grep/^$currclone$/,@$oldcloner) {
                   2781:                 ($uname,$udom) = split/:/,$currclone;
                   2782:                 if ($uname && $udom) {
                   2783:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2784:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2785:                         if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   2786:                             if ($currclonecrs{'cloneable'} eq '') {
                   2787:                                 $currclonecrs{'cloneable'} = $clone_crs;
                   2788:                             } else {
                   2789:                                 $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   2790:                             }
                   2791:                             &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                   2792:                         }
                   2793:                     }
                   2794:                 }
                   2795:             }
                   2796:         }
                   2797:         foreach my $oldclone (@$oldcloner) {
                   2798:             if (!grep/^$oldclone$/,@allowclone) {
                   2799:                 ($uname,$udom) = split/:/,$oldclone;
                   2800:                 if ($uname && $udom) {
                   2801:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2802:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2803:                         my %newclonecrs = ();
                   2804:                         if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   2805:                             if ($currclonecrs{'cloneable'} =~ /,/) {
                   2806:                                 my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   2807:                                 foreach (@currclonecrs) {
                   2808:                                     unless ($_ eq $clone_crs) {
                   2809:                                         $newclonecrs{'cloneable'} .= $_.',';
                   2810:                                     }
                   2811:                                 }
                   2812:                                 $newclonecrs{'cloneable'} =~ s/,$//;
                   2813:                             } else {
                   2814:                                 $newclonecrs{'cloneable'} = '';
                   2815:                             }
                   2816:                             &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                   2817:                         }
                   2818:                     }
                   2819:                 }
                   2820:             }
                   2821:         }
                   2822:     }
                   2823: }
                   2824: 
1.193     albertel 2825: 
                   2826: ##################################################
                   2827: ##################################################
                   2828: 
                   2829: =pod
                   2830: 
                   2831: =item * header
                   2832: 
                   2833: Output html header for page
                   2834: 
                   2835: =cut
                   2836: 
                   2837: ##################################################
                   2838: ##################################################
                   2839: sub header {
                   2840:     my $html=&Apache::lonxml::xmlbegin();
                   2841:     my $bodytag=&Apache::loncommon::bodytag('Parameter Manager');
                   2842:     my $title = &mt('LON-CAPA Parameter Manager');
                   2843:     return(<<ENDHEAD);
                   2844: $html
                   2845: <head>
                   2846: <title>$title</title>
                   2847: </head>
                   2848: $bodytag
                   2849: ENDHEAD
                   2850: }
                   2851: ##################################################
                   2852: ##################################################
                   2853: sub print_main_menu {
                   2854:     my ($r,$parm_permission)=@_;
                   2855:     #
                   2856:     $r->print(<<ENDMAINFORMHEAD);
                   2857: <form method="post" enctype="multipart/form-data"
                   2858:       action="/adm/parmset" name="studentform">
                   2859: ENDMAINFORMHEAD
                   2860: #
1.195     albertel 2861:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   2862:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 2863:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
                   2864: 
1.193     albertel 2865:     my @menu =
                   2866:         (
                   2867:           { text => 'Set Course Environment Parameters',
1.204     www      2868: 	    action => 'crsenv',
1.193     albertel 2869:             permission => $parm_permission,
                   2870:             },
1.255     banghart 2871:           { text => 'Set Portfolio Metadata',
1.259     banghart 2872: 	    action => 'setrestrictmeta',
1.240     banghart 2873:             permission => $parm_permission,
                   2874:             },
1.271   ! www      2875: 	  { text => 'Manage Course Slots',
1.268     albertel 2876: 	    url => '/adm/slotrequest?command=showslots',
                   2877: 	    permission => $vgr,
                   2878:             },
                   2879: 	  { divider => 1,
                   2880: 	    },
1.216     www      2881:           { text => 'Set/Modify Resource Parameters - Helper Mode',
1.193     albertel 2882:             url => '/adm/helper/parameter.helper',
                   2883:             permission => $parm_permission,
                   2884:             },
1.216     www      2885:           { text => 'Modify Resource Parameters - Overview Mode',
1.193     albertel 2886:             action => 'setoverview',
                   2887:             permission => $parm_permission,
1.208     www      2888:             },          
1.216     www      2889: 	  { text => 'Set Resource Parameters - Overview Mode',
1.208     www      2890:             action => 'newoverview',
                   2891:             permission => $parm_permission,
1.193     albertel 2892:             },
1.216     www      2893:           { text => 'Set/Modify Resource Parameters - Table Mode',
1.193     albertel 2894:             action => 'settable',
                   2895:             permission => $parm_permission,
1.204     www      2896:             help => 'Cascading_Parameters',
1.193     albertel 2897:             },
1.220     www      2898:           { text => 'Set Parameter Setting Default Actions',
                   2899:             action => 'setdefaults',
                   2900:             permission => $parm_permission,
                   2901:             },
1.193     albertel 2902:           );
                   2903:     my $menu_html = '';
                   2904:     foreach my $menu_item (@menu) {
1.268     albertel 2905: 	if ($menu_item->{'divider'}) {
                   2906: 	    $menu_html .= '<hr />';
                   2907: 	    next;
                   2908: 	}
1.193     albertel 2909:         next if (! $menu_item->{'permission'});
                   2910:         $menu_html.='<p>';
                   2911:         $menu_html.='<font size="+1">';
                   2912:         if (exists($menu_item->{'url'})) {
                   2913:             $menu_html.=qq{<a href="$menu_item->{'url'}">};
                   2914:         } else {
                   2915:             $menu_html.=
                   2916:                 qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
                   2917:         }
                   2918:         $menu_html.= &mt($menu_item->{'text'}).'</a></font>';
                   2919:         if (exists($menu_item->{'help'})) {
                   2920:             $menu_html.=
                   2921:                 &Apache::loncommon::help_open_topic($menu_item->{'help'});
                   2922:         }
                   2923:         $menu_html.='</p>'.$/;
                   2924:     }
                   2925:     $r->print($menu_html);
                   2926:     return;
                   2927: }
1.255     banghart 2928: ### Set portfolio metadata
1.252     banghart 2929: sub output_row {
1.255     banghart 2930:     my ($r, $field_name, $field_text) = @_;
1.252     banghart 2931:     my $output;
1.263     banghart 2932:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   2933:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.254     banghart 2934:     unless (defined($options)) {
                   2935:         $options = 'active,stuadd';
1.261     banghart 2936:         $values = '';
1.252     banghart 2937:     }
1.260     banghart 2938:     $output.='<strong>'.$field_text.':</strong>';
1.264     albertel 2939:     $output.='<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /><br />';
                   2940: 
                   2941:     my @options= ( ['active', 'Show to student'],
                   2942: 		   ['onlyone','Student may select only one choice'],
                   2943: 		   ['stuadd', 'Student may type choices']);
                   2944:     foreach my $opt (@options) {
                   2945: 	my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   2946: 	$output.=('&nbsp;'x5).'<label><input type="checkbox" name="'.
                   2947: 	    $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   2948: 	    &mt($opt->[1]).'</label> <br />';
1.252     banghart 2949:     }
                   2950:     return ($output);
                   2951: }
1.259     banghart 2952: 
                   2953: sub setrestrictmeta {
1.240     banghart 2954:     my ($r)=@_;
1.242     banghart 2955:     my $next_meta;
1.244     banghart 2956:     my $output;
1.245     banghart 2957:     my $item_num;
1.246     banghart 2958:     my $put_result;
1.240     banghart 2959:     $r->print(&Apache::lonxml::xmlbegin());
                   2960:     $r->print('<head>
1.260     banghart 2961:             <title>LON-CAPA Restrict Metadata</title>
1.240     banghart 2962:             </head>');
1.260     banghart 2963:     $r->print(&Apache::loncommon::bodytag('Restrict Metadata'));
1.240     banghart 2964:     $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
1.260     banghart 2965: 						    'Restrict Metadata'));
1.240     banghart 2966:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2967:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.259     banghart 2968:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 2969:     my $save_field = '';
1.259     banghart 2970:     if ($env{'form.restrictmeta'}) {
1.254     banghart 2971:         foreach my $field (sort(keys(%env))) {
1.252     banghart 2972:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 2973:                 my $options;
1.252     banghart 2974:                 my $meta_field = $1;
                   2975:                 my $meta_key = $2;
1.253     banghart 2976:                 if ($save_field ne $meta_field) {
1.252     banghart 2977:                     $save_field = $meta_field;
1.253     banghart 2978:             	    if ($env{'form.'.$meta_field.'_stuadd'}) {
1.254     banghart 2979:             	        $options.='stuadd,';
                   2980:             	    } 
1.253     banghart 2981:             	    if ($env{'form.'.$meta_field.'_onlyone'}) {
1.254     banghart 2982:             	        $options.='onlyone,';
                   2983:             	    } 
                   2984:             	    if ($env{'form.'.$meta_field.'_active'}) {
                   2985:             	        $options.='active,';
1.253     banghart 2986:             	    }
1.259     banghart 2987:                     my $name = $save_field;
1.253     banghart 2988:                      $put_result = &Apache::lonnet::put('environment',
1.262     banghart 2989:                                                   {'metadata.'.$meta_field.'.options'=>$options,
                   2990:                                                    'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
1.253     banghart 2991:                                                    },$dom,$crs);
1.252     banghart 2992:                 }
                   2993:             }
                   2994:         }
                   2995:     }
                   2996:     &Apache::lonnet::coursedescription($env{'request.course.id'});
1.258     albertel 2997:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
                   2998:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 2999:         &Apache::lonnet::logthis ($field);
                   3000:         if ($field ne 'courserestricted') {
                   3001: 	    $output.= &output_row($r, $field, $metadata_fields{$field});
                   3002: 	}
1.255     banghart 3003:     }
1.244     banghart 3004:     $r->print(<<ENDenv);       
1.259     banghart 3005:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 3006:         <p>
                   3007:         $output
1.259     banghart 3008:         <input type="submit" name="restrictmeta" value="Update Metadata Restrictions">
1.244     banghart 3009:         </form>
                   3010: ENDenv
1.241     banghart 3011:     $r->print('</body>
                   3012:                 </html>');
1.240     banghart 3013:     return 'ok';
                   3014: }
1.220     www      3015: ##################################################
1.193     albertel 3016: 
1.220     www      3017: sub defaultsetter {
                   3018:     my $r=shift;
                   3019:     my $bodytag=&Apache::loncommon::bodytag('Parameter Setting Default Actions');
                   3020:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   3021:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   3022:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Defaults');
                   3023:     my $html=&Apache::lonxml::xmlbegin();
                   3024:     $r->print(<<ENDDEFHEAD);
                   3025: $html
                   3026: <head>
                   3027: <title>LON-CAPA Parameters</title>
                   3028: </head>
                   3029: $bodytag
                   3030: $breadcrumbs
                   3031: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
                   3032: ENDDEFHEAD
1.221     www      3033:     my @ids=();
                   3034:     my %typep=();
                   3035:     my %keyp=();
                   3036:     my %allparms=();
                   3037:     my %allparts=();
                   3038:     my %allmaps=();
                   3039:     my %mapp=();
                   3040:     my %symbp=();
                   3041:     my %maptitles=();
                   3042:     my %uris=();
                   3043:     my %keyorder=&standardkeyorder();
                   3044:     my %defkeytype=();
                   3045: 
                   3046:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps, 
                   3047: 				\%mapp, \%symbp,\%maptitles,\%uris,
                   3048: 				\%keyorder,\%defkeytype);
1.224     www      3049:     if ($env{'form.storerules'}) {
                   3050: 	my %newrules=();
                   3051: 	my @delrules=();
1.226     www      3052: 	my %triggers=();
1.225     albertel 3053: 	foreach my $key (keys(%env)) {
                   3054:             if ($key=~/^form\.(\w+)\_action$/) {
1.224     www      3055: 		my $tempkey=$1;
1.226     www      3056: 		my $action=$env{$key};
                   3057:                 if ($action) {
                   3058: 		    $newrules{$tempkey.'_action'}=$action;
                   3059: 		    if ($action ne 'default') {
                   3060: 			my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   3061: 			$triggers{$whichparm}.=$tempkey.':';
                   3062: 		    }
                   3063: 		    $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224     www      3064: 		    if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3065: 			$newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224     www      3066: 			$newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   3067: 			$newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   3068: 			$newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   3069: 		    } else {
                   3070: 			$newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227     www      3071: 			$newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224     www      3072: 		    }
                   3073: 		} else {
1.225     albertel 3074: 		    push(@delrules,$tempkey.'_action');
1.226     www      3075: 		    push(@delrules,$tempkey.'_type');
1.225     albertel 3076: 		    push(@delrules,$tempkey.'_hours');
                   3077: 		    push(@delrules,$tempkey.'_min');
                   3078: 		    push(@delrules,$tempkey.'_sec');
                   3079: 		    push(@delrules,$tempkey.'_value');
1.224     www      3080: 		}
                   3081: 	    }
                   3082: 	}
1.226     www      3083: 	foreach my $key (keys %allparms) {
                   3084: 	    $newrules{$key.'_triggers'}=$triggers{$key};
                   3085: 	}
1.224     www      3086: 	&Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
                   3087: 	&Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
                   3088: 	&resetrulescache();
                   3089:     }
1.227     www      3090:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
                   3091: 				       'hours' => 'Hours',
1.221     www      3092: 				       'min' => 'Minutes',
                   3093: 				       'sec' => 'Seconds',
                   3094: 				       'yes' => 'Yes',
                   3095: 				       'no' => 'No');
1.222     www      3096:     my @standardoptions=('','default');
                   3097:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   3098:     my @dateoptions=('','default');
                   3099:     my @datedisplay=('',&mt('Default value when manually setting'));
                   3100:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
                   3101: 	unless ($tempkey) { next; }
                   3102: 	push @standardoptions,'when_setting_'.$tempkey;
                   3103: 	push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   3104: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3105: 	    push @dateoptions,'later_than_'.$tempkey;
                   3106: 	    push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   3107: 	    push @dateoptions,'earlier_than_'.$tempkey;
                   3108: 	    push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   3109: 	} 
                   3110:     }
1.231     www      3111: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   3112: 	  &mt('Automatic setting rules apply to table mode interfaces only.'));
1.221     www      3113:     $r->print("\n<table border='1'><tr><th>".&mt('Rule for parameter').'</th><th>'.
1.222     www      3114: 	      &mt('Action').'</th><th>'.&mt('Value').'</th></tr>');
1.221     www      3115:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222     www      3116: 	unless ($tempkey) { next; }
1.221     www      3117: 	$r->print("\n<tr><td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222     www      3118: 	my $action=&rulescache($tempkey.'_action');
                   3119: 	$r->print('<select name="'.$tempkey.'_action">');
                   3120: 	if (&isdateparm($defkeytype{$tempkey})) {
                   3121: 	    for (my $i=0;$i<=$#dateoptions;$i++) {
                   3122: 		if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   3123: 		$r->print("\n<option value='$dateoptions[$i]'".
                   3124: 			  ($dateoptions[$i] eq $action?' selected="selected"':'').
                   3125: 			  ">$datedisplay[$i]</option>");
                   3126: 	    }
                   3127: 	} else {
                   3128: 	    for (my $i=0;$i<=$#standardoptions;$i++) {
                   3129: 		if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   3130: 		$r->print("\n<option value='$standardoptions[$i]'".
                   3131: 			  ($standardoptions[$i] eq $action?' selected="selected"':'').
                   3132: 			  ">$standarddisplay[$i]</option>");
                   3133: 	    }
                   3134: 	}
                   3135: 	$r->print('</select>');
1.227     www      3136: 	unless (&isdateparm($defkeytype{$tempkey})) {
                   3137: 	    $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   3138: 		      '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
                   3139: 	}
1.222     www      3140: 	$r->print("\n</td><td>\n");
                   3141: 
1.221     www      3142:         if (&isdateparm($defkeytype{$tempkey})) {
1.227     www      3143: 	    my $days=&rulescache($tempkey.'_days');
1.222     www      3144: 	    my $hours=&rulescache($tempkey.'_hours');
                   3145: 	    my $min=&rulescache($tempkey.'_min');
                   3146: 	    my $sec=&rulescache($tempkey.'_sec');
1.221     www      3147: 	    $r->print(<<ENDINPUTDATE);
1.227     www      3148: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222     www      3149: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   3150: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   3151: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221     www      3152: ENDINPUTDATE
                   3153: 	} elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222     www      3154:             my $yeschecked='';
                   3155:             my $nochecked='';
                   3156:             if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked='checked="checked"'; }
                   3157:             if (&rulescache($tempkey.'_value') eq 'no') { $nochecked='checked="checked"'; }
                   3158: 
1.221     www      3159: 	    $r->print(<<ENDYESNO);
1.224     www      3160: <label><input type="radio" name="$tempkey\_value" value="yes" $yeschecked /> $lt{'yes'}</label><br />
                   3161: <label><input type="radio" name="$tempkey\_value" value="no" $nochecked /> $lt{'no'}</label>
1.221     www      3162: ENDYESNO
                   3163:         } else {
1.224     www      3164: 	    $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221     www      3165: 	}
                   3166:         $r->print('</td></tr>');
                   3167:     }
1.224     www      3168:     $r->print("</table>\n<input type='submit' name='storerules' value='".
                   3169: 	      &mt('Store Rules')."' /></form>\n</body>\n</html>");
1.220     www      3170:     return;
                   3171: }
1.193     albertel 3172: 
1.178     raeburn  3173: ##################################################
                   3174: ##################################################
1.30      www      3175: 
1.59      matthew  3176: =pod
                   3177: 
1.83      bowersj2 3178: =item * handler
1.59      matthew  3179: 
                   3180: Main handler.  Calls &assessparms and &crsenv subroutines.
                   3181: 
                   3182: =cut
                   3183: ##################################################
                   3184: ##################################################
1.220     www      3185: #    use Data::Dumper;
                   3186: 
1.259     banghart 3187: 
1.30      www      3188: sub handler {
1.43      albertel 3189:     my $r=shift;
1.30      www      3190: 
1.43      albertel 3191:     if ($r->header_only) {
1.126     www      3192: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 3193: 	$r->send_http_header;
                   3194: 	return OK;
                   3195:     }
1.193     albertel 3196:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205     www      3197: 					    ['action','state',
                   3198:                                              'pres_marker',
                   3199:                                              'pres_value',
1.206     www      3200:                                              'pres_type',
1.243     banghart 3201:                                              'udom','uname','symb','serial']);
1.131     www      3202: 
1.83      bowersj2 3203: 
1.193     albertel 3204:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 3205:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
                   3206: 					    text=>"Parameter Manager",
1.204     www      3207: 					    faq=>10,
1.194     albertel 3208: 					    bug=>'Instructor Interface'});
1.203     www      3209: 
1.30      www      3210: # ----------------------------------------------------- Needs to be in a course
1.194     albertel 3211:     my $parm_permission =
                   3212: 	(&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190     albertel 3213: 	 &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193     albertel 3214: 				  $env{'request.course.sec'}));
1.194     albertel 3215:     if ($env{'request.course.id'} &&  $parm_permission) {
1.193     albertel 3216: 
                   3217:         # Start Page
1.126     www      3218:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      3219:         $r->send_http_header;
1.30      www      3220: 
1.203     www      3221: 
                   3222:         # id numbers can change on re-ordering of folders
                   3223: 
                   3224:         &resetsymbcache();
                   3225: 
1.193     albertel 3226:         #
                   3227:         # Main switch on form.action and form.state, as appropriate
                   3228:         #
                   3229:         # Check first if coming from someone else headed directly for
                   3230:         #  the table mode
                   3231:         if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   3232: 	     && (!$env{'form.dis'})) || ($env{'form.symb'})) {
                   3233: 	    &assessparms($r);
                   3234: 
                   3235:         } elsif (! exists($env{'form.action'})) {
                   3236:             $r->print(&header());
1.194     albertel 3237:             $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
                   3238: 							 'Parameter Manager'));
1.193     albertel 3239:             &print_main_menu($r,$parm_permission);
                   3240:         } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) {
1.194     albertel 3241:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv',
                   3242: 						    text=>"Course Environment"});
1.193     albertel 3243:             &crsenv($r); 
                   3244:         } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194     albertel 3245:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3246: 						    text=>"Overview Mode"});
1.121     www      3247: 	    &overview($r);
1.259     banghart 3248:         } elsif ($env{'form.action'} eq 'setrestrictmeta' && $parm_permission) {
                   3249:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
                   3250: 						    text=>"Restrict Metadata"});
                   3251: 	    &setrestrictmeta($r);
1.208     www      3252:         } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) {
                   3253:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
                   3254: 						    text=>"Overview Mode"});
                   3255: 	    &newoverview($r);
1.220     www      3256:         }  elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) {
                   3257:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
                   3258: 						    text=>"Set Defaults"});
                   3259: 	    &defaultsetter($r);
                   3260: 	} elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194     albertel 3261:             &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.204     www      3262: 						    text=>"Table Mode",
                   3263: 						    help => 'Course_Setting_Parameters'});
1.121     www      3264: 	    &assessparms($r);
1.193     albertel 3265:         }
                   3266:         
1.43      albertel 3267:     } else {
1.1       www      3268: # ----------------------------- Not in a course, or not allowed to modify parms
1.190     albertel 3269: 	$env{'user.error.msg'}=
1.43      albertel 3270: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   3271: 	return HTTP_NOT_ACCEPTABLE;
                   3272:     }
                   3273:     return OK;
1.1       www      3274: }
                   3275: 
                   3276: 1;
                   3277: __END__
                   3278: 
1.59      matthew  3279: =pod
1.38      harris41 3280: 
                   3281: =back
                   3282: 
                   3283: =cut
1.1       www      3284: 
                   3285: 
                   3286: 

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