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

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

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