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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.56      www         4: # $Id: lonparmset.pm,v 1.55 2002/07/22 14:23:29 bowersj2 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.1       www        28: # (Handler to resolve ambiguous file locations
                     29: #
                     30: # (TeX Content Handler
                     31: #
1.38      harris41   32: # YEAR=2000
1.1       www        33: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                     34: #
                     35: # 10/11,10/12,10/16 Gerd Kortemeyer)
                     36: #
1.20      www        37: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
1.21      www        38: # 12/08,12/12,
1.38      harris41   39: # YEAR=2001
1.30      www        40: # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09,
1.35      www        41: # 07/05,07/06,08/08,08/09,09/01,09/21 Gerd Kortemeyer
1.38      harris41   42: # 12/17 Scott Harrison
1.41      www        43: # 12/19 Guy Albertelli
1.42      www        44: # 12/26,12/27 Gerd Kortemeyer
1.38      harris41   45: #
1.55      bowersj2   46: # YEAR=2002
                     47: # 7/19 Jeremy Bowers
1.38      harris41   48: ###
1.1       www        49: 
                     50: package Apache::lonparmset;
                     51: 
                     52: use strict;
                     53: use Apache::lonnet;
                     54: use Apache::Constants qw(:common :http REDIRECT);
1.36      albertel   55: use Apache::loncommon;
1.1       www        56: use GDBM_File;
1.57    ! albertel   57: use Apache::lonhomework;
        !            58: use Apache::lonxml;
1.4       www        59: 
1.1       www        60: 
1.2       www        61: my %courseopt;
                     62: my %useropt;
                     63: my %parmhash;
                     64: 
1.3       www        65: my @ids;
                     66: my %symbp;
1.10      www        67: my %mapp;
1.3       www        68: my %typep;
1.16      www        69: my %keyp;
1.2       www        70: 
                     71: my $uname;
                     72: my $udom;
                     73: my $uhome;
                     74: my $csec;
1.57    ! albertel   75: my $coursename;
1.2       www        76: 
                     77: # -------------------------------------------- Figure out a cascading parameter
                     78: 
                     79: sub parmval {
1.11      www        80:     my ($what,$id,$def)=@_;
1.8       www        81:     my $result='';
1.44      albertel   82:     my @outpar=();
1.2       www        83: # ----------------------------------------------------- Cascading lookup scheme
1.10      www        84: 
1.43      albertel   85:     my $symbparm=$symbp{$id}.'.'.$what;
                     86:     my $mapparm=$mapp{$id}.'___(all).'.$what;
1.10      www        87: 
1.43      albertel   88:     my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
                     89:     my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                     90:     my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                     91: 
                     92:     my $courselevel=$ENV{'request.course.id'}.'.'.$what;
                     93:     my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
                     94:     my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
1.2       www        95: 
1.11      www        96: # -------------------------------------------------------- first, check default
                     97: 
1.43      albertel   98:     if ($def) { $outpar[11]=$def; $result=11; }
1.11      www        99: 
                    100: # ----------------------------------------------------- second, check map parms
                    101: 
1.43      albertel  102:     my $thisparm=$parmhash{$symbparm};
                    103:     if ($thisparm) { $outpar[10]=$thisparm; $result=10; }
1.11      www       104: 
                    105: # --------------------------------------------------------- third, check course
                    106: 
1.43      albertel  107:     if ($courseopt{$courselevel}) {
                    108: 	$outpar[9]=$courseopt{$courselevel};
                    109: 	$result=9;
                    110:     }
1.11      www       111: 
1.43      albertel  112:     if ($courseopt{$courselevelm}) {
                    113: 	$outpar[8]=$courseopt{$courselevelm};
                    114: 	$result=8;
                    115:     }
1.11      www       116: 
1.43      albertel  117:     if ($courseopt{$courselevelr}) {
                    118: 	$outpar[7]=$courseopt{$courselevelr};
                    119: 	$result=7;
                    120:     }
1.11      www       121: 
1.43      albertel  122:     if ($csec) {
                    123:         if ($courseopt{$seclevel}) {
                    124: 	    $outpar[6]=$courseopt{$seclevel};
                    125: 	    $result=6;
                    126: 	}
                    127:         if ($courseopt{$seclevelm}) {
                    128: 	    $outpar[5]=$courseopt{$seclevelm};
                    129: 	    $result=5;
                    130: 	}
                    131: 
                    132:         if ($courseopt{$seclevelr}) {
                    133: 	    $outpar[4]=$courseopt{$seclevelr};
                    134: 	    $result=4;
                    135: 	}
                    136:     }
1.11      www       137: 
                    138: # ---------------------------------------------------------- fourth, check user
                    139: 
1.43      albertel  140:     if ($uname) {
                    141: 	if ($useropt{$courselevel}) {
                    142: 	    $outpar[3]=$useropt{$courselevel};
                    143: 	    $result=3;
                    144: 	}
1.10      www       145: 
1.43      albertel  146: 	if ($useropt{$courselevelm}) {
                    147: 	    $outpar[2]=$useropt{$courselevelm};
                    148: 	    $result=2;
                    149: 	}
1.2       www       150: 
1.43      albertel  151: 	if ($useropt{$courselevelr}) {
                    152: 	    $outpar[1]=$useropt{$courselevelr};
                    153: 	    $result=1;
                    154: 	}
                    155:     }
1.10      www       156: 
1.44      albertel  157:     return ($result,@outpar);
1.2       www       158: }
                    159: 
1.9       www       160: # ------------------------------------------------------------ Output for value
                    161: 
                    162: sub valout {
                    163:     my ($value,$type)=@_;
1.43      albertel  164:     return ($value?(($type=~/^date/)?localtime($value):$value):'  ');
1.9       www       165: }
                    166: 
1.5       www       167: # -------------------------------------------------------- Produces link anchor
                    168: 
                    169: sub plink {
                    170:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       171:     my $winvalue=$value;
                    172:     unless ($winvalue) {
                    173: 	if ($type=~/^date/) {
                    174:             $winvalue=$ENV{'form.recent_'.$type};
                    175:         } else {
                    176:             $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
                    177:         }
                    178:     }
                    179:     return 
1.43      albertel  180: 	'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                    181: 	    .$marker."','".$return."','".$call."'".');">'.
                    182: 		&valout($value,$type).'</a><a name="'.$marker.'"></a>';
1.5       www       183: }
                    184: 
1.44      albertel  185: 
                    186: sub startpage {
                    187:     my ($r,$id,$udom,$csec,$uname)=@_;
                    188:     $r->content_type('text/html');
                    189:     $r->send_http_header;
                    190:     $r->print(<<ENDHEAD);
                    191: <html>
                    192: <head>
                    193: <title>LON-CAPA Course Parameters</title>
                    194: <script>
                    195: 
                    196:     function pclose() {
                    197:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    198:                  "height=350,width=350,scrollbars=no,menubar=no");
                    199:         parmwin.close();
                    200:     }
                    201: 
                    202:     function pjump(type,dis,value,marker,ret,call) {
                    203:         document.parmform.pres_marker.value='';
                    204:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    205:                  +"&value="+escape(value)+"&marker="+escape(marker)
                    206:                  +"&return="+escape(ret)
                    207:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
                    208:                  "height=350,width=350,scrollbars=no,menubar=no");
                    209: 
                    210:     }
                    211: 
                    212:     function psub() {
                    213:         pclose();
                    214:         if (document.parmform.pres_marker.value!='') {
                    215:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    216:             var typedef=new Array();
                    217:             typedef=document.parmform.pres_type.value.split('_');
                    218:            if (document.parmform.pres_type.value!='') {
                    219:             if (typedef[0]=='date') {
                    220:                 eval('document.parmform.recent_'+
                    221:                      document.parmform.pres_type.value+
                    222: 		     '.value=document.parmform.pres_value.value;');
                    223:             } else {
                    224:                 eval('document.parmform.recent_'+typedef[0]+
                    225: 		     '.value=document.parmform.pres_value.value;');
                    226:             }
                    227: 	   }
                    228:             document.parmform.submit();
                    229:         } else {
                    230:             document.parmform.pres_value.value='';
                    231:             document.parmform.pres_marker.value='';
                    232:         }
                    233:     }
                    234: 
1.57    ! albertel  235:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
        !           236:         var options = "width=" + w + ",height=" + h + ",";
        !           237:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
        !           238:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
        !           239:         var newWin = window.open(url, wdwName, options);
        !           240:         newWin.focus();
        !           241:     }
1.44      albertel  242: </script>
                    243: </head>
                    244: <body bgcolor="#FFFFFF" onUnload="pclose()">
1.57    ! albertel  245: <h1>Set Course Parameters for Course:
        !           246: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h1>
1.44      albertel  247: <form method="post" action="/adm/parmset" name="envform">
                    248: <h3>Course Environment</h3>
                    249: <input type="submit" name="crsenv" value="Set Course Environment">
                    250: </form>
                    251: <form method="post" action="/adm/parmset" name="parmform">
                    252: <h3>Course Assessments</h3>
                    253: <b>
                    254: Section/Group:
                    255: <input type="text" value="$csec" size="6" name="csec">
                    256: <br>
                    257: For User 
                    258: <input type="text" value="$uname" size="12" name="uname">
                    259: or ID
                    260: <input type="text" value="$id" size="12" name="id"> 
                    261: at Domain 
                    262: <input type="text" value="$udom" size="6" name="udom">
                    263: </b>
                    264: <input type="hidden" value='' name="pres_value">
                    265: <input type="hidden" value='' name="pres_type">
                    266: <input type="hidden" value='' name="pres_marker">
                    267: ENDHEAD
                    268: 
                    269: }
                    270: 
                    271: sub print_row {
                    272:     my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone,
1.57    ! albertel  273: 	$defbgtwo,$parmlev)=@_;
1.44      albertel  274:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
                    275: 				  $rid,$$default{$which});
1.57    ! albertel  276:     my $parm=$$display{$which};
        !           277: 
        !           278:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
        !           279:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
        !           280:                   .$$part{$which}.'</td>');
        !           281:     } else {    
        !           282:         $parm=~s|\[.*\]\s||g;
        !           283:     }
        !           284: 
        !           285:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
        !           286:    
1.44      albertel  287:     my $thismarker=$which;
                    288:     $thismarker=~s/^parameter\_//;
                    289:     my $mprefix=$rid.'&'.$thismarker.'&';
                    290: 
1.57    ! albertel  291:     if ($parmlev eq 'general') {
        !           292: 
        !           293:         if ($uname) {
        !           294:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           295:         } elsif ($csec) {
        !           296:             &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); 
        !           297:         } else {
        !           298:             &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 
        !           299:         }
        !           300:     } elsif ($parmlev eq 'map') {
        !           301: 
        !           302:         if ($uname) {
        !           303:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           304:         } elsif ($csec) {
        !           305:             &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
        !           306:         } else {
        !           307:             &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           308:         }
        !           309:     } else {
        !           310: 
        !           311:         &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
        !           312: 
        !           313:         if ($parmlev eq 'brief') {
        !           314: 
        !           315:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           316: 
        !           317:            if ($csec) {
        !           318:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
        !           319:            }
        !           320:            if ($uname) {
        !           321:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           322:            }
        !           323:         } else {
        !           324: 
        !           325:            &print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
        !           326:            &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           327:            &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           328:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           329: 
        !           330:            if ($csec) {
        !           331:                &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
        !           332:                &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
        !           333:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
        !           334:            }
        !           335:            if ($uname) {
        !           336:                &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           337:                &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           338:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
        !           339:            }
        !           340:         } # end of $brief if/else
        !           341:     } # end of $parmlev if/else
        !           342: 
        !           343:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
        !           344:     $r->print('<td bgcolor=#CCCCFF align="center">'.
        !           345:         &valout($outpar[$result],$$type{$which}).'</td>');
        !           346: 
        !           347: }
1.44      albertel  348:     my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.57    ! albertel  349:                                         '.'.$$name{$which},$symbp{$rid});
        !           350:     $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
        !           351:                   &valout($sessionval,$$type{$which}).'&nbsp;'.
        !           352:                   '</font></td>');
1.44      albertel  353:     $r->print('</tr>');
1.57    ! albertel  354:     $r->print("\n");
1.44      albertel  355: }
                    356: sub print_td {
                    357:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_;
1.57    ! albertel  358:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
        !           359:               ' align="center">'.
        !           360:               &plink($$type{$value},$$display{$value},$$outpar[$which],
        !           361:                      $mprefix."$which",'parmform.pres','psub').'</td>'."\n");
        !           362: }
        !           363: 
        !           364: sub get_env_multiple {
        !           365:     my ($name) = @_;
        !           366:     my @values;
        !           367:     if (defined($ENV{$name})) {
        !           368:         # exists is it an array
        !           369:         if (ref($ENV{$name})) {
        !           370:             @values=@{ $ENV{$name} };
        !           371:         } else {
        !           372:             $values[0]=$ENV{$name};
        !           373:         }
        !           374:     }
        !           375:     return(@values);
1.44      albertel  376: }
                    377: 
1.30      www       378: sub assessparms {
1.1       www       379: 
1.43      albertel  380:     my $r=shift;
1.2       www       381: # -------------------------------------------------------- Variable declaration
1.43      albertel  382:     my %allkeys;
                    383:     my %allmaps;
1.57    ! albertel  384:     my %alllevs;
        !           385: 
        !           386:     $alllevs{'Resource Level'}='full';
        !           387: #    $alllevs{'Resource Level [BRIEF]'}='brief';
        !           388:     $alllevs{'Map Level'}='map';
        !           389:     $alllevs{'Course Level'}='general';
        !           390: 
        !           391:     my %allparms;
        !           392:     my %allparts;
        !           393: 
1.43      albertel  394:     my %defp;
                    395:     %courseopt=();
                    396:     %useropt=();
1.44      albertel  397:     my %bighash=();
1.43      albertel  398: 
                    399:     @ids=();
                    400:     %symbp=();
                    401:     %typep=();
                    402: 
                    403:     my $message='';
                    404: 
                    405:     $csec=$ENV{'form.csec'};
                    406:     $udom=$ENV{'form.udom'};
                    407:     unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
                    408: 
1.57    ! albertel  409:     my @pscat=&get_env_multiple('form.pscat');
1.43      albertel  410:     my $pschp=$ENV{'form.pschp'};
1.57    ! albertel  411:     my @psprt=&get_env_multiple('form.psprt');
        !           412:     my $showoptions=$ENV{'form.showoptions'};
        !           413: 
1.43      albertel  414:     my $pssymb='';
1.57    ! albertel  415:     my $parmlev='';
        !           416:     my $prevvisit=$ENV{'form.prevvisit'};
        !           417: 
        !           418: #    unless ($parmlev==$ENV{'form.parmlev'}) {
        !           419: #        $parmlev = 'full';
        !           420: #    }
        !           421:  
        !           422:     unless ($ENV{'form.parmlev'}) {
        !           423:         $parmlev = 'map';
        !           424:     } else {
        !           425:         $parmlev = $ENV{'form.parmlev'};
        !           426:     }
1.26      www       427: 
1.29      www       428: # ----------------------------------------------- Was this started from grades?
                    429: 
1.43      albertel  430:     if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
                    431: 	&& (!$ENV{'form.dis'})) {
                    432: 	my $url=$ENV{'form.url'};
                    433: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    434: 	$pssymb=&Apache::lonnet::symbread($url);
1.57    ! albertel  435: 	@pscat='all';
1.43      albertel  436: 	$pschp='';
1.57    ! albertel  437:         $parmlev = 'full';
1.43      albertel  438:     } elsif ($ENV{'form.symb'}) {
                    439: 	$pssymb=$ENV{'form.symb'};
1.57    ! albertel  440: 	@pscat='all';
1.43      albertel  441: 	$pschp='';
1.57    ! albertel  442:         $parmlev = 'full';
1.43      albertel  443:     } else {
                    444: 	$ENV{'form.url'}='';
                    445:     }
                    446: 
                    447:     my $id=$ENV{'form.id'};
                    448:     if (($id) && ($udom)) {
                    449: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                    450: 	if ($uname) {
                    451: 	    $id='';
                    452: 	} else {
                    453: 	    $message=
                    454: 		"<font color=red>Unknown ID '$id' at domain '$udom'</font>";
                    455: 	}
                    456:     } else {
                    457: 	$uname=$ENV{'form.uname'};
                    458:     }
                    459:     unless ($udom) { $uname=''; }
                    460:     $uhome='';
                    461:     if ($uname) {
                    462: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                    463:         if ($uhome eq 'no_host') {
                    464: 	    $message=
                    465: 		"<font color=red>Unknown user '$uname' at domain '$udom'</font>";
                    466: 	    $uname='';
1.12      www       467:         } else {
1.43      albertel  468: 	    $csec=&Apache::lonnet::usection($udom,$uname,
                    469: 					    $ENV{'request.course.id'});
                    470: 	    if ($csec eq '-1') {
                    471: 		$message="<font color=red>".
1.45      matthew   472: 		    "User '$uname' at domain '$udom' not ".
                    473:                     "in this course</font>";
1.43      albertel  474: 		$uname='';
                    475: 		$csec=$ENV{'form.csec'};
                    476: 	    } else {
                    477: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                    478: 		      ('firstname','middlename','lastname','generation','id'));
                    479: 		$message="\n<p>\nFull Name: ".
                    480: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                    481: 			.$name{'lastname'}.' '.$name{'generation'}.
                    482: 			    "<br>\nID: ".$name{'id'}.'<p>';
                    483: 	    }
1.12      www       484:         }
1.43      albertel  485:     }
1.2       www       486: 
1.43      albertel  487:     unless ($csec) { $csec=''; }
1.12      www       488: 
1.44      albertel  489:     my $fcat=$ENV{'form.fcat'};
1.43      albertel  490:     unless ($fcat) { $fcat=''; }
1.2       www       491: 
                    492: # ------------------------------------------------------------------- Tie hashs
1.44      albertel  493:     if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                    494: 	      &GDBM_READER,0640))) {
                    495: 	$r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
                    496: 	return ;
                    497:     }
                    498:     if (!(tie(%parmhash,'GDBM_File',
                    499: 	      $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
                    500: 	$r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
                    501: 	return ;
                    502:     }
1.14      www       503: # --------------------------------------------------------- Get all assessments
1.44      albertel  504:     foreach (keys %bighash) {
                    505: 	if ($_=~/^src\_(\d+)\.(\d+)$/) {
                    506: 	    my $mapid=$1;
                    507: 	    my $resid=$2;
                    508: 	    my $id=$mapid.'.'.$resid;
                    509: 	    my $srcf=$bighash{$_};
                    510: 	    if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
                    511: 		$ids[$#ids+1]=$id;
                    512: 		$typep{$id}=$1;
                    513: 		$keyp{$id}='';
1.57    ! albertel  514: 		foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
        !           515: 		  if ($_=~/^parameter\_(.*)/) {
        !           516:                     my $key=$_;
        !           517:                     my $allkey=$1;
        !           518:                     $allkey=~s/\_/\./g;
        !           519:                     my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
        !           520:                     my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
        !           521:                     my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
        !           522:                     my $parmdis = $display;
        !           523:                     $parmdis =~ s|(\[Part.*$)||g;
        !           524:                     my $partkey = $part;
        !           525:                     $partkey =~ tr|_|.|;
        !           526:                     $allparms{$name} = $parmdis;
        !           527:                     $allparts{$part} = "[Part $part]";
        !           528:                     $allkeys{$allkey}=$display;
        !           529:                     if ($allkey eq $fcat) {
        !           530: 		        $defp{$id}= &Apache::lonnet::metadata($srcf,$key);
        !           531: 		    }
        !           532: 		    if ($keyp{$id}) {
        !           533: 		        $keyp{$id}.=','.$key;
        !           534: 		    } else {
        !           535: 		        $keyp{$id}=$key;
1.43      albertel  536: 		    }
1.57    ! albertel  537: 		  }
1.44      albertel  538: 		}
                    539: 		$mapp{$id}=
                    540: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
1.57    ! albertel  541:                 $mapp{$mapid}=$mapp{$id};
1.44      albertel  542: 		$allmaps{$mapid}=$mapp{$id};
                    543: 		$symbp{$id}=$mapp{$id}.
1.14      www       544: 			'___'.$resid.'___'.
1.16      www       545: 			    &Apache::lonnet::declutter($srcf);
1.57    ! albertel  546:                 $symbp{$mapid}=$mapp{$id}.'___(all)';
1.44      albertel  547: 	    }
                    548: 	}
                    549:     }
1.57    ! albertel  550:     $mapp{'0.0'} = '';
        !           551:     $symbp{'0.0'} = '';
1.14      www       552: # ---------------------------------------------------------- Anything to store?
1.44      albertel  553:     if ($ENV{'form.pres_marker'}) {
                    554: 	my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
                    555: 	$spnam=~s/\_([^\_]+)$/\.$1/;
1.15      www       556: # ---------------------------------------------------------- Construct prefixes
1.14      www       557: 
1.44      albertel  558: 	my $symbparm=$symbp{$sresid}.'.'.$spnam;
                    559: 	my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
                    560: 	
                    561: 	my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    562: 	my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    563: 	my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    564: 	
                    565: 	my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
                    566: 	my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
                    567: 	my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
                    568: 	
                    569: 	my $storeunder='';
                    570: 	if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
                    571: 	if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
                    572: 	if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
                    573: 	if ($snum==6) { $storeunder=$seclevel; }
                    574: 	if ($snum==5) { $storeunder=$seclevelm; }
                    575: 	if ($snum==4) { $storeunder=$seclevelr; }
                    576: 	
1.45      matthew   577:         my %storecontent = ($storeunder        => $ENV{'form.pres_value'},
                    578:                             $storeunder.'type' => $ENV{'form.pres_type'});
1.44      albertel  579: 	my $reply='';
                    580: 	if ($snum>3) {
1.14      www       581: # ---------------------------------------------------------------- Store Course
1.24      www       582: #
                    583: # Expire sheets
1.44      albertel  584: 	    &Apache::lonnet::expirespread('','','studentcalc');
                    585: 	    if (($snum==7) || ($snum==4)) {
                    586: 		&Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
                    587: 	    } elsif (($snum==8) || ($snum==5)) {
                    588: 		&Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
                    589: 	    } else {
                    590: 		&Apache::lonnet::expirespread('','','assesscalc');
                    591: 	    }
1.24      www       592: # Store parameter
1.45      matthew   593:             $reply=&Apache::lonnet::cput
                    594:                 ('resourcedata',\%storecontent,
                    595:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    596:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44      albertel  597: 	} else {
1.14      www       598: # ------------------------------------------------------------------ Store User
1.24      www       599: #
                    600: # Expire sheets
1.44      albertel  601: 	    &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    602: 	    if ($snum==1) {
                    603: 		&Apache::lonnet::expirespread
                    604: 		    ($uname,$udom,'assesscalc',$symbp{$sresid});
                    605: 	    } elsif ($snum==2) {
                    606: 		&Apache::lonnet::expirespread
                    607: 		    ($uname,$udom,'assesscalc',$mapp{$sresid});
                    608: 	    } else {
                    609: 		&Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    610: 	    }
1.24      www       611: # Store parameter
1.45      matthew   612: 	    $reply=&Apache::lonnet::cput
                    613:                 ('resourcedata',\%storecontent,$udom,$uname);
1.44      albertel  614: 	}
1.15      www       615: 
1.44      albertel  616: 	if ($reply=~/^error\:(.*)/) {
                    617: 	    $message.="<font color=red>Write Error: $1</font>";
                    618: 	}
1.15      www       619: # ---------------------------------------------------------------- Done storing
1.44      albertel  620:     }
1.2       www       621: # -------------------------------------------------------------- Get coursedata
1.45      matthew   622:     %courseopt = &Apache::lonnet::dump
                    623:         ('resourcedata',
                    624:          $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    625:          $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44      albertel  626: # --------------------------------------------------- Get userdata (if present)
                    627:     if ($uname) {
1.45      matthew   628:         %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
1.44      albertel  629:     }
1.14      www       630: 
1.2       www       631: # ------------------------------------------------------------------- Sort this
1.17      www       632: 
1.44      albertel  633:     @ids=sort  {
                    634: 	if ($fcat eq '') {
                    635: 	    $a<=>$b;
                    636: 	} else {
                    637: 	    my ($result,@outpar)=&parmval($fcat,$a,$defp{$a});
                    638: 	    my $aparm=$outpar[$result];
                    639: 	    ($result,@outpar)=&parmval($fcat,$b,$defp{$b});
                    640: 	    my $bparm=$outpar[$result];
                    641: 	    1*$aparm<=>1*$bparm;
                    642: 	}
                    643:     } @ids;
1.57    ! albertel  644: #----------------------------------------------- if all selected, fill in array
        !           645:     if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
        !           646:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www       647: # ------------------------------------------------------------------ Start page
1.44      albertel  648:     &startpage($r,$id,$udom,$csec,$uname);
                    649: #    if ($ENV{'form.url'}) {
                    650: #	$r->print('<input type="hidden" value="'.$ENV{'form.url'}.
                    651: #		  '" name="url"><input type="hidden" name="command" value="set">');
                    652: #    }
1.57    ! albertel  653:     $r->print('<input type="hidden" value="true" name="prevvisit">');
        !           654: 
1.44      albertel  655:     foreach ('tolerance','date_default','date_start','date_end',
                    656: 	     'date_interval','int','float','string') {
                    657: 	$r->print('<input type="hidden" value="'.
                    658: 		  $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
                    659:     }
                    660: 
1.57    ! albertel  661:     $r->print('<h2>'.$message.'</h2><table>');
        !           662:                         
        !           663:     $r->print('<tr><td><hr /></td></tr>');
        !           664: 
        !           665:     my $submitmessage;
        !           666:     if (($prevvisit) || ($pschp) || ($pssymb)) {
        !           667:         $submitmessage = "Update Display";
        !           668:     } else {
        !           669:         $submitmessage = "Display";
1.13      www       670:     }
1.44      albertel  671:     if (!$pssymb) {
1.57    ! albertel  672:         $r->print('<tr><td>Select Parameter Level</td><td>');
        !           673:         $r->print('<select name="parmlev">');
        !           674:         foreach (reverse sort keys %alllevs) {
        !           675:             $r->print('<option value="'.$alllevs{$_}.'"');
        !           676:             if ($parmlev eq $alllevs{$_}) {
        !           677:                $r->print(' selected'); 
        !           678:             }
        !           679:             $r->print('>'.$_.'</option>');
        !           680:         }
        !           681:         $r->print("</select></td>\n");
        !           682:     
        !           683:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
        !           684: 
        !           685:         $r->print('</tr><tr><td><hr /></td>');
        !           686: 
        !           687:         $r->print('<tr><td>Select Enclosing Map</td>');
        !           688:         $r->print('<td colspan="2"><select name="pschp">');
        !           689:         $r->print('<option value="all">All Maps</option>');
        !           690:         foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
        !           691:             $r->print('<option value="'.$_.'"');
        !           692:             if (($pschp eq $_)) { $r->print(' selected'); }
        !           693:             $r->print('>/res/'.$allmaps{$_}.'</option>');
        !           694:         }
        !           695:         $r->print("</select></td></tr>\n");
1.44      albertel  696:     } else {
1.57    ! albertel  697:         my ($map,$id,$resource)=split(/___/,$pssymb);
        !           698:         $r->print("<tr><td>Specific Resource</td><td>$resource</td>");
        !           699:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
        !           700:         $r->print('</tr>');
        !           701:         $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
        !           702:     }
        !           703: 
        !           704:     $r->print('<tr><td colspan="3"><hr /><input type="checkbox"');
        !           705:     if ($showoptions eq 'show') {$r->print(" checked ");}
        !           706:     $r->print(' name="showoptions" value="show" onclick="form.submit();">Show More Options<hr /></td></tr>');
        !           707: #    $r->print("<tr><td>Show: $showoptions</td></tr>");
        !           708: #    $r->print("<tr><td>pscat: @pscat</td></tr>");
        !           709: #    $r->print("<tr><td>psprt: @psprt</td></tr>");
        !           710: #    $r->print("<tr><td>fcat:  $fcat</td></tr>");
        !           711: 
        !           712:     if ($showoptions eq 'show') {
        !           713:         my $tempkey;
        !           714: 
        !           715:         $r->print('<tr><td colspan="3" align="center">Select Parameters to View</td></tr>');
        !           716: 
        !           717:         $r->print('<tr><td colspan="2"><table>');
        !           718:         $r->print('<tr><td><input type="checkbox" name="pscat" value="all"');
        !           719:         $r->print(' checked') unless (@pscat);
        !           720:         $r->print('>All Parameters</td>');
        !           721: 
        !           722:         my $cnt=0;
        !           723: 
        !           724:         foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
        !           725:                       keys %allparms ) {
        !           726:             ++$cnt;
        !           727:             $r->print('</tr><tr>') unless ($cnt%2);
        !           728:             $r->print('<td><input type="checkbox" name="pscat" ');
        !           729:             $r->print('value="'.$tempkey.'"');
        !           730:             if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
        !           731:                 $r->print(' checked');
        !           732:             }
        !           733:             $r->print('>'.$allparms{$tempkey}.'</td>');
        !           734:         }
        !           735:         $r->print('</tr></table>');
        !           736: 
        !           737: #        $r->print('<tr><td>Select Parts</td><td>');
        !           738:         $r->print('<td><select multiple name="psprt" size="5">');
        !           739:         $r->print('<option value="all"');
        !           740:         $r->print(' selected') unless (@psprt);
        !           741:         $r->print('>All Parts</option>');
        !           742:         foreach $tempkey (sort keys %allparts) {
        !           743:             unless ($tempkey =~ /\./) {
        !           744:                 $r->print('<option value="'.$tempkey.'"');
        !           745:                 if ($psprt[0] eq "all" ||  grep $_ == $tempkey, @psprt) {
        !           746:                     $r->print(' selected');
        !           747:                 }
        !           748:                 $r->print('>'.$allparts{$tempkey}.'</option>');
        !           749:             }
        !           750:         }
        !           751:         $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
        !           752: 
        !           753:         $r->print('<tr><td>Sort list by</td><td>');
        !           754:         $r->print('<select name="fcat">');
        !           755:         $r->print('<option value="">Enclosing Map</option>');
        !           756:         foreach (sort keys %allkeys) {
        !           757:             $r->print('<option value="'.$_.'"');
        !           758:             if ($fcat eq $_) { $r->print(' selected'); }
        !           759:             $r->print('>'.$allkeys{$_}.'</option>');
        !           760:         }
        !           761:         $r->print('</select></td>');
        !           762: 
        !           763:         $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
        !           764: 
        !           765:     } else { # hide options - include any necessary extras here
        !           766: 
        !           767:         $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
        !           768: 
        !           769:         unless (@pscat) {
        !           770:           foreach (keys %allparms ) {
        !           771:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
        !           772:           }
        !           773:         } else {
        !           774:           foreach (@pscat) {
        !           775:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
        !           776:           }
        !           777:         }
        !           778: 
        !           779:         unless (@psprt) {
        !           780:           foreach (keys %allparts ) {
        !           781:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
        !           782:           }
        !           783:         } else {
        !           784:           foreach (@psprt) {
        !           785:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
        !           786:           }
        !           787:         }
        !           788: 
1.44      albertel  789:     }
1.57    ! albertel  790:     $r->print('</table>');
        !           791: 
        !           792:     my @temp_psprt;
        !           793:     map {
        !           794:          my $t = $_;
        !           795:          push(@temp_psprt,
        !           796:          grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
        !           797:     } @psprt;
        !           798: 
        !           799:     @psprt = @temp_psprt;
        !           800: 
        !           801:     my @temp_pscat;
        !           802:     map {
        !           803:         my $cat = $_;
        !           804:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
        !           805:     } @pscat;
        !           806: 
        !           807:     @pscat = @temp_pscat;
        !           808: 
        !           809:     if (($prevvisit) || ($pschp) || ($pssymb)) {
1.10      www       810: # ----------------------------------------------------------------- Start Table
1.57    ! albertel  811:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
        !           812:         my $csuname=$ENV{'user.name'};
        !           813:         my $csudom=$ENV{'user.domain'};
        !           814: 
        !           815: 
        !           816:         if ($parmlev eq 'full' || $parmlev eq 'brief') {
        !           817: 
        !           818:            my $coursespan=$csec?8:5;
        !           819:            $r->print('<p><table border=2>');
        !           820:            $r->print('<tr><td colspan=5></td>');
        !           821:            $r->print('<th colspan='.($coursespan).'>Any User</th>');
        !           822:            if ($uname) {
        !           823:                $r->print("<th colspan=3 rowspan=2>");
        !           824:                $r->print("User $uname at Domain $udom</th>");
        !           825:            }
        !           826:            $r->print(<<ENDTABLETWO);
1.33      www       827: <th rowspan=3>Parameter in Effect</th>
                    828: <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th>
1.57    ! albertel  829: </tr><tr><td colspan=5></td><th colspan=2>Resource Level</th>
1.10      www       830: <th colspan=3>in Course</th>
                    831: ENDTABLETWO
1.57    ! albertel  832:            if ($csec) {
        !           833:                 $r->print("<th colspan=3>in Section/Group $csec</th>");
        !           834:            }
        !           835:            $r->print(<<ENDTABLEHEADFOUR);
1.11      www       836: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
1.10      www       837: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
1.11      www       838: <th>default</th><th>from Enclosing Map</th>
1.10      www       839: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
                    840: ENDTABLEHEADFOUR
1.57    ! albertel  841: 
        !           842:            if ($csec) {
        !           843:                $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
        !           844:            }
        !           845: 
        !           846:            if ($uname) {
        !           847:                $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
        !           848:            }
        !           849: 
        !           850:            $r->print('</tr>');
        !           851: 
        !           852:            my $defbgone='';
        !           853:            my $defbgtwo='';
        !           854: 
        !           855:            foreach (@ids) {
        !           856: 
        !           857:                 my $rid=$_;
        !           858:                 my ($inmapid)=($rid=~/\.(\d+)$/);
        !           859: 
        !           860:                 if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
        !           861:                     ($pssymb eq $symbp{$rid})) {
1.4       www       862: # ------------------------------------------------------ Entry for one resource
1.57    ! albertel  863:                     if ($defbgone eq '"E0E099"') {
        !           864:                         $defbgone='"E0E0DD"';
        !           865:                     } else {
        !           866:                         $defbgone='"E0E099"';
        !           867:                     }
        !           868:                     if ($defbgtwo eq '"FFFF99"') {
        !           869:                         $defbgtwo='"FFFFDD"';
        !           870:                     } else {
        !           871:                         $defbgtwo='"FFFF99"';
        !           872:                     }
        !           873:                     my $thistitle='';
        !           874:                     my %name=   ();
        !           875:                     undef %name;
        !           876:                     my %part=   ();
        !           877:                     my %display=();
        !           878:                     my %type=   ();
        !           879:                     my %default=();
        !           880:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
        !           881: 
        !           882:                     foreach (split(/\,/,$keyp{$rid})) {
        !           883:                         my $tempkeyp = $_;
        !           884:                         if (grep $_ eq $tempkeyp, @catmarker) {
        !           885:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
        !           886:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
        !           887:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
        !           888:                           unless ($display{$_}) { $display{$_}=''; }
        !           889:                           $display{$_}.=' ('.$name{$_}.')';
        !           890:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
        !           891:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
        !           892:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
        !           893:                         }
        !           894:                     }
        !           895:                     my $totalparms=scalar keys %name;
        !           896:                     if ($totalparms>0) {
        !           897:                         my $firstrow=1;
        !           898: 
        !           899:                         $r->print('<tr><td bgcolor='.$defbgone.
        !           900:                              ' rowspan='.$totalparms.
        !           901:                              '><tt><font size=-1>'.
        !           902:                              join(' / ',split(/\//,$uri)).
        !           903:                              '</font></tt><p><b>'.
        !           904:                              "<a href=\"javascript:openWindow('/res/".$uri.
        !           905:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
        !           906:                              " TARGET=_self>$bighash{'title_'.$rid}");
        !           907: 
        !           908:                         if ($thistitle) {
        !           909:                             $r->print(' ('.$thistitle.')');
        !           910:                         }
        !           911:                         $r->print('</a></b></td>');
        !           912:                         $r->print('<td bgcolor='.$defbgtwo.
        !           913:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
        !           914:                                       '</td>');
        !           915: 
        !           916:                         $r->print('<td bgcolor='.$defbgone.
        !           917:                                       ' rowspan='.$totalparms.
        !           918:                                       '><tt><font size=-1>');
        !           919: 
        !           920:                         $r->print(' / res / ');
        !           921:                         $r->print(join(' / ', split(/\//,$mapp{$rid})));
        !           922: 
        !           923:                         $r->print('</font></tt></td>');
        !           924: 
        !           925:                         foreach (sort keys %name) {
        !           926:                             unless ($firstrow) {
        !           927:                                 $r->print('<tr>');
        !           928:                             } else {
        !           929:                                 undef $firstrow;
        !           930:                             }
        !           931: 
        !           932:                             &print_row($r,$_,\%part,\%name,$rid,\%default,
        !           933:                                        \%type,\%display,$defbgone,$defbgtwo,
        !           934:                                        $parmlev);
        !           935:                         }
        !           936:                     }
        !           937:                 }
        !           938:             } # end foreach ids
1.43      albertel  939: # -------------------------------------------------- End entry for one resource
1.57    ! albertel  940:             $r->print('</table>');
        !           941:         } # end of  brief/full
        !           942: #--------------------------------------------------- Entry for parm level map
        !           943:         if ($parmlev eq 'map') {
        !           944:             my $defbgone = '"E0E099"';
        !           945:             my $defbgtwo = '"FFFF99"';
        !           946: 
        !           947:             my %maplist;
        !           948: 
        !           949:             if ($pschp eq 'all') {
        !           950:                 %maplist = %allmaps; 
        !           951:             } else {
        !           952:                 %maplist = ($pschp => $mapp{$pschp});
        !           953:             }
        !           954: 
        !           955: #-------------------------------------------- for each map, gather information
        !           956:             my $mapid;
        !           957:             foreach $mapid (keys %maplist) {
        !           958:                 my $maptitle = $allmaps{$mapid};
        !           959: 
        !           960: #-----------------------  loop through ids and get all parameter types for map
        !           961: #-----------------------------------------          and associated information
        !           962:                 my %name = ();
        !           963:                 my %part = ();
        !           964:                 my %display = ();
        !           965:                 my %type = ();
        !           966:                 my %default = ();
        !           967:                 my $map = 0;
        !           968: 
        !           969: #		$r->print("Catmarker: @catmarker<br />\n");
        !           970:                
        !           971:                 foreach (@ids) {
        !           972:                   ($map)=(/([\d]*?)\./);
        !           973:                   my $rid = $_;
        !           974:         
        !           975: #                  $r->print("$mapid:$map:   $rid <br /> \n");
        !           976: 
        !           977:                   if ($map eq $mapid) {
        !           978:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
        !           979: #                    $r->print("Keys: $keyp{$rid} <br />\n");
        !           980: 
        !           981: #--------------------------------------------------------------------
        !           982: # @catmarker contains list of all possible parameters including part #s
        !           983: # $fullkeyp contains the full part/id # for the extraction of proper parameters
        !           984: # $tempkeyp contains part 0 only (no ids - ie, subparts)
        !           985: # When storing information, store as part 0
        !           986: # When requesting information, request from full part
        !           987: #-------------------------------------------------------------------
        !           988:                     foreach (split(/\,/,$keyp{$rid})) {
        !           989:                       my $tempkeyp = $_;
        !           990:                       my $fullkeyp = $tempkeyp;
        !           991:                       $tempkeyp =~ s/_[\d_]+_/_0_/;
        !           992:                       
        !           993:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
        !           994:                         $part{$tempkeyp}="0";
        !           995:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
        !           996:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
        !           997:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
        !           998:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
        !           999:                         $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
        !          1000:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
        !          1001:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
        !          1002:                       }
        !          1003:                     } # end loop through keys
        !          1004:                   }
        !          1005:                 } # end loop through ids
        !          1006:                                  
        !          1007: #---------------------------------------------------- print header information
        !          1008:                 $r->print(<<ENDMAPONE);
        !          1009: <center><h4>
        !          1010: <font color="red">Set Defaults for All Resources in map
        !          1011: <i>$maptitle</i><br />
        !          1012: Specifically for
        !          1013: ENDMAPONE
        !          1014:                 if ($uname) {
        !          1015:                     my %name=&Apache::lonnet::userenvironment($udom,$uname,
        !          1016:                       ('firstname','middlename','lastname','generation', 'id'));
        !          1017:                     my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
        !          1018:                            .$name{'lastname'}.' '.$name{'generation'};
        !          1019:                     $r->print("User <i>$uname \($person\) </i> in \n");
        !          1020:                 } else {
        !          1021:                     $r->print("<i>all</i> users in \n");
        !          1022:                 }
        !          1023:             
        !          1024:                 if ($csec) {$r->print("Section <i>$csec</i> of \n")};
        !          1025: 
        !          1026:                 $r->print("<i>$coursename</i><br />");
        !          1027:                 $r->print("</font></h4>\n");
        !          1028: #---------------------------------------------------------------- print table
        !          1029:                 $r->print('<p><table border="2">');
        !          1030:                 $r->print('<tr><th>Parameter Name</th>');
        !          1031:                 $r->print('<th>Default Value</th>');
        !          1032:                 $r->print('<th>Parameter in Effect</th></tr>');
        !          1033: 
        !          1034: 	        foreach (sort keys %name) {
        !          1035:                     &print_row($r,$_,\%part,\%name,$mapid,\%default,
        !          1036:                            \%type,\%display,$defbgone,$defbgtwo,
        !          1037:                            $parmlev);
        !          1038: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
        !          1039:                 }
        !          1040:                 $r->print("</table></center>");
        !          1041:             } # end each map
        !          1042:         } # end of $parmlev eq map
        !          1043: #--------------------------------- Entry for parm level general (Course level)
        !          1044:         if ($parmlev eq 'general') {
        !          1045:             my $defbgone = '"E0E099"';
        !          1046:             my $defbgtwo = '"FFFF99"';
        !          1047: 
        !          1048: #-------------------------------------------- for each map, gather information
        !          1049:             my $mapid="0.0";
        !          1050: #-----------------------  loop through ids and get all parameter types for map
        !          1051: #-----------------------------------------          and associated information
        !          1052:             my %name = ();
        !          1053:             my %part = ();
        !          1054:             my %display = ();
        !          1055:             my %type = ();
        !          1056:             my %default = ();
        !          1057:                
        !          1058:             foreach (@ids) {
        !          1059:                 my $rid = $_;
        !          1060:         
        !          1061:                 my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
        !          1062: 
        !          1063: #--------------------------------------------------------------------
        !          1064: # @catmarker contains list of all possible parameters including part #s
        !          1065: # $fullkeyp contains the full part/id # for the extraction of proper parameters
        !          1066: # $tempkeyp contains part 0 only (no ids - ie, subparts)
        !          1067: # When storing information, store as part 0
        !          1068: # When requesting information, request from full part
        !          1069: #-------------------------------------------------------------------
        !          1070:                 foreach (split(/\,/,$keyp{$rid})) {
        !          1071:                   my $tempkeyp = $_;
        !          1072:                   my $fullkeyp = $tempkeyp;
        !          1073:                   $tempkeyp =~ s/_[\d_]+_/_0_/;
        !          1074:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
        !          1075:                     $part{$tempkeyp}="0";
        !          1076:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
        !          1077:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
        !          1078:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
        !          1079:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
        !          1080:                     $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
        !          1081:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
        !          1082:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
        !          1083:                   }
        !          1084:                 } # end loop through keys
        !          1085:             } # end loop through ids
        !          1086:                                  
        !          1087: #---------------------------------------------------- print header information
        !          1088:             $r->print(<<ENDMAPONE);
        !          1089: <center><h4>
        !          1090: <font color="red">Set Defaults for All Resources in Course
        !          1091: <i>$coursename</i><br />
        !          1092: ENDMAPONE
        !          1093:             if ($uname) {
        !          1094:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
        !          1095:                   ('firstname','middlename','lastname','generation', 'id'));
        !          1096:                 my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
        !          1097:                        .$name{'lastname'}.' '.$name{'generation'};
        !          1098:                 $r->print(" User <i>$uname \($person\) </i> \n");
        !          1099:             } else {
        !          1100:                 $r->print("<i>ALL</i> USERS \n");
        !          1101:             }
        !          1102:             
        !          1103:             if ($csec) {$r->print("Section <i>$csec</i>\n")};
        !          1104:             $r->print("</font></h4>\n");
        !          1105: #---------------------------------------------------------------- print table
        !          1106:             $r->print('<p><table border="2">');
        !          1107:             $r->print('<tr><th>Parameter Name</th>');
        !          1108:             $r->print('<th>Default Value</th>');
        !          1109:             $r->print('<th>Parameter in Effect</th></tr>');
        !          1110: 
        !          1111: 	    foreach (sort keys %name) {
        !          1112:                 &print_row($r,$_,\%part,\%name,$mapid,\%default,
        !          1113:                        \%type,\%display,$defbgone,$defbgtwo,$parmlev);
        !          1114: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
        !          1115:             }
        !          1116:             $r->print("</table></center>");
        !          1117:         } # end of $parmlev eq general
1.43      albertel 1118:     }
1.44      albertel 1119:     $r->print('</form></body></html>');
                   1120:     untie(%bighash);
                   1121:     untie(%parmhash);
1.57    ! albertel 1122: } # end sub assessparms
1.30      www      1123: 
1.57    ! albertel 1124: # ------------------------------------------- Set course environment parameters
1.30      www      1125: sub crsenv {
                   1126:     my $r=shift;
                   1127:     my $setoutput='';
1.45      matthew  1128:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1129:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.30      www      1130: # -------------------------------------------------- Go through list of changes
1.38      harris41 1131:     foreach (keys %ENV) {
1.30      www      1132: 	if ($_=~/^form\.(.+)\_setparmval$/) {
                   1133:             my $name=$1;
                   1134:             my $value=$ENV{'form.'.$name.'_value'};
                   1135:             if ($name eq 'newp') {
                   1136:                 $name=$ENV{'form.newp_name'};
                   1137:             }
                   1138:             if ($name eq 'url') {
                   1139: 		$value=~s/^\/res\///;
1.45      matthew  1140:                 my @tmp = &Apache::lonnet::get
                   1141:                     ('environment',['url'],$dom,$crs);
1.30      www      1142:                 $setoutput.='Backing up previous URL: '.
1.45      matthew  1143:                     &Apache::lonnet::put
                   1144:                         ('environment',
                   1145:                          {'top level map backup ' => $tmp[1] },
                   1146:                          $dom,$crs).
                   1147:                     '<br>';
1.30      www      1148:             }
                   1149:             if ($name) {
1.45      matthew  1150:                 $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
                   1151:                     $value.'</tt>: '.
                   1152:                     &Apache::lonnet::put
                   1153:                             ('environment',{$name=>$value},$dom,$crs).
                   1154:                     '<br>';
1.30      www      1155: 	    }
                   1156:         }
1.38      harris41 1157:     }
1.30      www      1158: # -------------------------------------------------------- Get parameters again
1.45      matthew  1159: 
                   1160:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.30      www      1161:     my $output='';
1.45      matthew  1162:     if (! exists($values{'con_lost'})) {
1.30      www      1163:         my %descriptions=
1.47      matthew  1164: 	    ('url'            => '<b>Top Level Map</b> '.
1.46      matthew  1165:                                  '<a href="javascript:openbrowser'.
1.47      matthew  1166:                                  "('envform','url','sequence')\">".
1.46      matthew  1167:                                  'Browse</a><br><font color=red> '.
1.45      matthew  1168:                                  'Modification may make assessment data '.
                   1169:                                  'inaccessible</font>',
                   1170:              'description'    => '<b>Course Description</b>',
                   1171:              'courseid'       => '<b>Course ID or number</b><br>'.
                   1172:                                  '(internal, optional)',
1.52      www      1173:              'default_xml_style' => '<b>Default XML Style File</b> '.
                   1174:                     '<a href="javascript:openbrowser'.
                   1175:                     "('envform','default_xml_style'".
                   1176:                     ",'sty')\">Browse</a><br>",
1.45      matthew  1177:              'question.email' => '<b>Feedback Addresses for Content '.
                   1178:                                  'Questions</b><br>(<tt>user:domain,'.
                   1179:                                  'user:domain,...</tt>)',
                   1180:              'comment.email'  => '<b>Feedback Addresses for Comments</b><br>'.
                   1181:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   1182:              'policy.email'   => '<b>Feedback Addresses for Course Policy</b>'.
                   1183:                                  '<br>(<tt>user:domain,user:domain,...</tt>)',
                   1184:              'hideemptyrows'  => '<b>Hide Empty Rows in Spreadsheets</b><br>'.
                   1185:                                  '("<tt>yes</tt>" for default hiding)',
1.54      www      1186:              'pageseparators'  => '<b>Visibly Separate Items on Pages</b><br>'.
                   1187:                                  '("<tt>yes</tt>" for visible separation)',
1.45      matthew  1188:              'pch.roles.denied'=> '<b>Disallow Resource Discussion for '.
1.57    ! albertel 1189:                                   'Roles</b> ' . 
        !          1190: 	   Apache::loncommon::help_open_topic("Course_Disable_Discussion")
        !          1191: 	                          ,
1.53      www      1192:              'pch.users.denied' => 
                   1193:                           '<b>Disallow Resource Discussion for Users</b><br>'.
                   1194:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  1195:              'spreadsheet_default_classcalc' 
1.52      www      1196:                  => '<b>Default Course Spreadsheet</b> '.
1.50      matthew  1197:                     '<a href="javascript:openbrowser'.
                   1198:                     "('envform','spreadsheet_default_classcalc'".
                   1199:                     ",'spreadsheet')\">Browse</a><br>",
1.49      matthew  1200:              'spreadsheet_default_studentcalc' 
1.52      www      1201:                  => '<b>Default Student Spreadsheet</b> '.
1.50      matthew  1202:                     '<a href="javascript:openbrowser'.
                   1203:                     "('envform','spreadsheet_default_calc'".
                   1204:                     ",'spreadsheet')\">Browse</a><br>",
1.49      matthew  1205:              'spreadsheet_default_assesscalc' 
1.52      www      1206:                  => '<b>Default Assessment Spreadsheet</b> '.
1.50      matthew  1207:                     '<a href="javascript:openbrowser'.
                   1208:                     "('envform','spreadsheet_default_assesscalc'".
                   1209:                     ",'spreadsheet')\">Browse</a><br>",
1.45      matthew  1210:              );
                   1211: 	foreach (keys(%values)) {
                   1212: 	    unless ($descriptions{$_}) {
                   1213: 		$descriptions{$_}=$_;
1.43      albertel 1214: 	    }
                   1215: 	}
                   1216: 	foreach (sort keys %descriptions) {
1.51      matthew  1217:             # onchange is javascript to automatically check the 'Set' button.
                   1218:             my $onchange = 'onchange="javascript:window.document.forms'.
                   1219:                 '[\'envform\'].elements[\''.$_.'_setparmval\']'.
                   1220:                 '.checked=true;"';
                   1221: 	    $output.='<tr><td>'.$descriptions{$_}.'</td>'.
                   1222:                 '<td><input name="'.$_.'_value" size=40 '.
                   1223:                 'value="'.$values{$_}.'" '.$onchange.' /></td>'.
                   1224:                 '<td><input type=checkbox name="'.$_.'_setparmval"></td>'.
                   1225:                 '</tr>'."\n";
                   1226: 	}
                   1227:         my $onchange = 'onchange="javascript:window.document.forms'.
                   1228:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   1229:             '.checked=true;"';
                   1230: 	$output.='<tr><td><i>Create New Environment Variable</i><br />'.
                   1231: 	    '<input type="text" size=40 name="newp_name" '.
                   1232:                 $onchange.' /></td><td>'.
                   1233:             '<input type="text" size=40 name="newp_value" '.
                   1234:                 $onchange.' /></td><td>'.
                   1235: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 1236:     }
1.30      www      1237:     $r->print(<<ENDENV);
                   1238: <html>
1.46      matthew  1239: <script type="text/javascript" language="Javascript" >
                   1240:     var editbrowser;
1.47      matthew  1241:     function openbrowser(formname,elementname,only,omit) {
1.46      matthew  1242:         var url = '/res/?';
                   1243:         if (editbrowser == null) {
                   1244:             url += 'launch=1&';
                   1245:         }
                   1246:         url += 'catalogmode=interactive&';
                   1247:         url += 'mode=parmset&';
                   1248:         url += 'form=' + formname + '&';
1.47      matthew  1249:         if (only != null) {
                   1250:             url += 'only=' + only + '&';
                   1251:         } 
                   1252:         if (omit != null) {
                   1253:             url += 'omit=' + omit + '&';
                   1254:         }
1.46      matthew  1255:         url += 'element=' + elementname + '';
                   1256:         var title = 'Browser';
                   1257:         var options = 'scrollbars=1,resizable=1,menubar=0';
                   1258:         options += ',width=700,height=600';
                   1259:         editbrowser = open(url,title,options,'1');
                   1260:         editbrowser.focus();
                   1261:     }
                   1262: </script>
1.30      www      1263: <head>
                   1264: <title>LON-CAPA Course Environment</title>
                   1265: </head>
                   1266: <body bgcolor="#FFFFFF">
                   1267: <h1>Set Course Parameters</h1>
                   1268: <form method="post" action="/adm/parmset" name="envform">
                   1269: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
                   1270: <h3>Course Environment</h3>
                   1271: $setoutput
                   1272: <p>
                   1273: <table border=2>
                   1274: <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr>
                   1275: $output
                   1276: </table>
                   1277: <input type="submit" name="crsenv" value="Set Course Environment">
                   1278: </form>
                   1279: </body>
                   1280: </html>    
                   1281: ENDENV
                   1282: }
                   1283: 
                   1284: # ================================================================ Main Handler
                   1285: 
                   1286: sub handler {
1.43      albertel 1287:     my $r=shift;
1.30      www      1288: 
1.43      albertel 1289:     if ($r->header_only) {
                   1290: 	$r->content_type('text/html');
                   1291: 	$r->send_http_header;
                   1292: 	return OK;
                   1293:     }
                   1294:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.30      www      1295: # ----------------------------------------------------- Needs to be in a course
                   1296: 
1.43      albertel 1297:     if (($ENV{'request.course.id'}) && 
                   1298: 	(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.57    ! albertel 1299:  
        !          1300:         $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
1.30      www      1301: 
1.43      albertel 1302: 	unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
1.30      www      1303: # --------------------------------------------------------- Bring up assessment
1.43      albertel 1304: 	    &assessparms($r);
1.30      www      1305: # ---------------------------------------------- This is for course environment
1.43      albertel 1306: 	} else {
                   1307: 	    &crsenv($r);
                   1308: 	}
                   1309:     } else {
1.1       www      1310: # ----------------------------- Not in a course, or not allowed to modify parms
1.43      albertel 1311: 	$ENV{'user.error.msg'}=
                   1312: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   1313: 	return HTTP_NOT_ACCEPTABLE;
                   1314:     }
                   1315:     return OK;
1.1       www      1316: }
                   1317: 
                   1318: 1;
                   1319: __END__
                   1320: 
1.38      harris41 1321: 
                   1322: =head1 NAME
                   1323: 
                   1324: Apache::lonparmset - Handler to set parameters for assessments
                   1325: 
                   1326: =head1 SYNOPSIS
                   1327: 
                   1328: Invoked by /etc/httpd/conf/srm.conf:
                   1329: 
                   1330:  <Location /adm/parmset>
                   1331:  PerlAccessHandler       Apache::lonacc
                   1332:  SetHandler perl-script
                   1333:  PerlHandler Apache::lonparmset
                   1334:  ErrorDocument     403 /adm/login
                   1335:  ErrorDocument     406 /adm/roles
                   1336:  ErrorDocument	  500 /adm/errorhandler
                   1337:  </Location>
                   1338: 
                   1339: =head1 INTRODUCTION
                   1340: 
                   1341: This module sets assessment parameters.
                   1342: 
                   1343: This is part of the LearningOnline Network with CAPA project
                   1344: described at http://www.lon-capa.org.
                   1345: 
                   1346: =head1 HANDLER SUBROUTINE
                   1347: 
                   1348: This routine is called by Apache and mod_perl.
                   1349: 
                   1350: =over 4
                   1351: 
                   1352: =item *
                   1353: 
                   1354: need to be in course
                   1355: 
                   1356: =item *
                   1357: 
                   1358: bring up assessment screen or course environment
                   1359: 
                   1360: =back
                   1361: 
                   1362: =head1 OTHER SUBROUTINES
                   1363: 
                   1364: =over 4
                   1365: 
                   1366: =item *
                   1367: 
                   1368: parmval() : figure out a cascading parameter
                   1369: 
                   1370: =item *
                   1371: 
1.44      albertel 1372: valout() : format a value for output
1.38      harris41 1373: 
                   1374: =item *
                   1375: 
                   1376: plink() : produces link anchor
                   1377: 
                   1378: =item *
                   1379: 
                   1380: assessparms() : show assess data and parameters
                   1381: 
                   1382: =item *
                   1383: 
                   1384: crsenv() : for the course environment
                   1385: 
                   1386: =back
                   1387: 
                   1388: =cut
1.1       www      1389: 
                   1390: 
                   1391: 

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