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

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

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