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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
                      4: # (Handler to resolve ambiguous file locations
                      5: #
                      6: # (TeX Content Handler
                      7: #
                      8: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
                      9: #
                     10: # 10/11,10/12,10/16 Gerd Kortemeyer)
                     11: #
1.13    ! www        12: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27 Gerd Kortemeyer
1.1       www        13: 
                     14: package Apache::lonparmset;
                     15: 
                     16: use strict;
                     17: use Apache::lonnet;
                     18: use Apache::Constants qw(:common :http REDIRECT);
                     19: use GDBM_File;
1.4       www        20: use Apache::lonmeta;
                     21: 
1.1       www        22: 
1.2       www        23: my %courseopt;
                     24: my %useropt;
                     25: my %bighash;
                     26: my %parmhash;
                     27: 
1.8       www        28: my @outpar;
                     29: 
1.3       www        30: my @ids;
                     31: my %symbp;
1.10      www        32: my %mapp;
1.3       www        33: my %typep;
1.2       www        34: 
                     35: my $uname;
                     36: my $udom;
                     37: my $uhome;
                     38: 
                     39: my $csec;
                     40: 
1.3       www        41: my $fcat;
                     42: 
1.2       www        43: # -------------------------------------------- Figure out a cascading parameter
                     44: 
                     45: sub parmval {
1.11      www        46:     my ($what,$id,$def)=@_;
1.8       www        47:     my $result='';
1.11      www        48:     @outpar=();
1.2       www        49: # ----------------------------------------------------- Cascading lookup scheme
1.10      www        50: 
1.3       www        51:        my $symbparm=$symbp{$id}.'.'.$what;
1.10      www        52:        my $mapparm=$mapp{$id}.'___(all).'.$what;
                     53: 
1.2       www        54:        my $seclevel=
1.10      www        55:             $ENV{'request.course.id'}.'.['.
                     56: 		$ENV{'request.course.sec'}.'].'.$what;
                     57:        my $seclevelr=
                     58:             $ENV{'request.course.id'}.'.['.
                     59: 		$ENV{'request.course.sec'}.'].'.$symbparm;
                     60:        my $seclevelm=
                     61:             $ENV{'request.course.id'}.'.['.
                     62: 		$ENV{'request.course.sec'}.'].'.$mapparm;
                     63: 
1.2       www        64:        my $courselevel=
                     65:             $ENV{'request.course.id'}.'.'.$what;
1.10      www        66:        my $courselevelr=
                     67:             $ENV{'request.course.id'}.'.'.$symbparm;
                     68:        my $courselevelm=
                     69:             $ENV{'request.course.id'}.'.'.$mapparm;
1.2       www        70: 
1.11      www        71: # -------------------------------------------------------- first, check default
                     72: 
                     73:        if ($def) { $outpar[11]=$def;
                     74:                    $result=11; }
                     75: 
                     76: # ----------------------------------------------------- second, check map parms
                     77: 
                     78:        my $thisparm=$parmhash{$symbparm};
                     79:        if ($thisparm) { $outpar[10]=$thisparm;  
                     80:                         $result=10; }
                     81: 
                     82: # --------------------------------------------------------- third, check course
                     83: 
                     84:        if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel};  
                     85:                                        $result=9; }
                     86: 
                     87:        if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; 
                     88:                                         $result=8; }
                     89: 
                     90:        if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; 
                     91:                                         $result=7; }
                     92: 
                     93:        if ($csec) {
                     94: 
                     95:         if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel};  
                     96:                                     $result=6; }
                     97: 
                     98:         if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm};  
                     99:                                      $result=5; }  
                    100:  
                    101:         if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr};  
                    102:                                      $result=4; }
                    103:   
                    104:       }
                    105: 
                    106: # ---------------------------------------------------------- fourth, check user
1.8       www       107:       
                    108:       if ($uname) { 
1.11      www       109: 
1.10      www       110:        if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel};  
                    111:                                      $result=3; }
                    112: 
1.11      www       113:        if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; 
                    114:                                       $result=2; }
1.2       www       115: 
1.11      www       116:        if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; 
                    117:                                       $result=1; }
1.10      www       118: 
1.11      www       119:       }
1.2       www       120:      
1.8       www       121:     return $result;
1.2       www       122: }
                    123: 
1.3       www       124: # ---------------------------------------------------------------- Sort routine
                    125: 
                    126: sub bycat {
                    127:     if ($fcat eq '') {
                    128:         $a<=>$b;
                    129:     } else {
                    130:         &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);
                    131:     }
                    132: }
                    133: 
1.9       www       134: # ------------------------------------------------------------ Output for value
                    135: 
                    136: sub valout {
                    137:     my ($value,$type)=@_;
                    138:     return
                    139: 	($value?(($type=~/^date/)?localtime($value):$value):'&nbsp;&nbsp;');
                    140: }
                    141: 
1.5       www       142: # -------------------------------------------------------- Produces link anchor
                    143: 
                    144: sub plink {
                    145:     my ($type,$dis,$value,$marker,$return,$call)=@_;
                    146:     return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"
1.8       www       147:       .$marker."','".$return."','".$call."'".');">'.
1.9       www       148:       &valout($value,$type).'</a>';
1.5       www       149: }
                    150: 
1.1       www       151: # ================================================================ Main Handler
                    152: 
                    153: sub handler {
                    154:    my $r=shift;
                    155: 
                    156:    if ($r->header_only) {
                    157:       $r->content_type('text/html');
                    158:       $r->send_http_header;
                    159:       return OK;
                    160:    }
                    161: 
                    162: # ----------------------------------------------------- Needs to be in a course
                    163: 
                    164:    if (($ENV{'request.course.fn'}) && 
                    165:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.2       www       166: # -------------------------------------------------------- Variable declaration
                    167: 
                    168:       %courseopt=();
                    169:       %useropt=();
                    170:       %bighash=();
                    171: 
1.3       www       172:       @ids=();
                    173:       %symbp=();
                    174:       %typep=();
1.2       www       175: 
1.12      www       176:       my $message='';
                    177: 
                    178:       $csec=$ENV{'form.csec'};
1.2       www       179:       $udom=$ENV{'form.udom'};
1.12      www       180:       my $id=$ENV{'form.id'};
                    181:       if (($id) && ($udom)) {
                    182:           $uname=(&Apache::lonnet::idget($udom,$id))[1];
                    183:           if ($uname) {
                    184: 	      $id='';
                    185:           } else {
                    186:               $message=
                    187:      "<h3><font color=red>Unknown ID '$id' at domain '$udom'</font></h3>";
                    188:           }
                    189:       } else {
                    190:           $uname=$ENV{'form.uname'};
                    191:       }
1.2       www       192:       unless ($udom) { $uname=''; }
                    193:       $uhome='';
                    194:       if ($uname) {
                    195: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.12      www       196:       
                    197:         if ($uhome eq 'no_host') { 
1.3       www       198:           $message=
1.8       www       199:      "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";
1.3       www       200:           $uname=''; 
1.12      www       201:         } else {
                    202:           $csec=&Apache::lonnet::usection(
                    203: 				       $udom,$uname,$ENV{'request.course.id'});
                    204:           if ($csec eq '-1') {
                    205:              $message="<h3><font color=red>".
                    206:               "User '$uname' at domain '$udom' not in this course</font></h3>";
                    207:               $uname='';
                    208:               $csec=$ENV{'form.csec'};
                    209: 	 } else {
                    210:               my %name=&Apache::lonnet::userenvironment($udom,$uname,
                    211: 		('firstname','middlename','lastname','generation','id'));
                    212:               $message="\n<p>\nFull Name: ".
                    213:                           $name{'firstname'}.' '.$name{'middlename'}
                    214: 	                 .$name{'lastname'}.' '.$name{'generation'}.
                    215:                        "<br>\nID: ".$name{'id'}.'<p>';
                    216:          }
                    217:         }
1.3       www       218:       }
1.2       www       219: 
1.3       www       220:       unless ($csec) { $csec=''; }
1.12      www       221: 
1.3       www       222:       $fcat=$ENV{'form.fcat'};
                    223:       unless ($fcat) { $fcat=''; }
1.2       www       224: 
                    225: # ------------------------------------------------------------------- Tie hashs
                    226:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                    227:                        &GDBM_READER,0640)) &&
                    228:           (tie(%parmhash,'GDBM_File',
                    229:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
                    230: 
                    231: # -------------------------------------------------------------- Get coursedata
                    232:         my $reply=&Apache::lonnet::reply('dump:'.
                    233:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
                    234:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
                    235:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
                    236:         if ($reply!~/^error\:/) {
                    237:            map {
                    238:              my ($name,$value)=split(/\=/,$_);
                    239:              $courseopt{unescape($name)}=unescape($value);  
                    240:            } split(/\&/,$reply);
                    241:         }
                    242: # --------------------------------------------------- Get userdata (if present)
                    243:         if ($uname) {
                    244:            my $reply=
                    245:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
                    246:            if ($reply!~/^error\:/) {
                    247:               map {
                    248:                 my ($name,$value)=split(/\=/,$_);
                    249:                 $useropt{unescape($name)}=unescape($value);  
                    250:               } split(/\&/,$reply);
                    251:            }
                    252:         }
                    253: # --------------------------------------------------------- Get all assessments
                    254:         map {
                    255: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
                    256: 	       my $mapid=$1;
                    257:                my $resid=$2;
1.3       www       258:                my $id=$mapid.'.'.$resid;
1.2       www       259:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3       www       260: 		   $ids[$#ids+1]=$id;
                    261:                    $typep{$id}=$1;
1.10      www       262:                    $mapp{$id}=
                    263: 		       &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
                    264:                    $symbp{$id}=$mapp{$id}.
1.3       www       265: 			'___'.$resid.'___'.
                    266: 			    &Apache::lonnet::declutter($bighash{$_});
1.2       www       267: 	       }
                    268:             }
                    269:         } keys %bighash;
1.13    ! www       270: # ---------------------------------------------------------- Anything to store?
        !           271:         if ($ENV{'form.pres_marker'}) {
        !           272:            $message.="<h1>Storing $ENV{'form.pres.value'} type $ENV{'form.pres_type'} under $ENV{'form.pres_marker'}</h1>"; 
        !           273:         }
1.2       www       274: # ------------------------------------------------------------------- Sort this
1.3       www       275:          @ids=sort bycat @ids;
1.2       www       276: # ------------------------------------------------------------------ Start page
1.1       www       277:          $r->content_type('text/html');
                    278:          $r->send_http_header;
1.5       www       279: 	$r->print(<<ENDHEAD);
                    280: <html>
                    281: <head>
                    282: <title>LON-CAPA Assessment Parameters</title>
                    283: <script>
1.13    ! www       284: 
1.5       www       285:     function pclose() {
                    286:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    287:                  "height=350,width=350,scrollbars=no,menubar=no");
                    288:         parmwin.close();
                    289:     }
                    290: 
                    291:     function pjump(type,dis,value,marker,ret,call) {
1.13    ! www       292:         document.parmform.pres_marker.value='';
1.6       www       293:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
                    294:                  +"&value="+escape(value)+"&marker="+escape(marker)
                    295:                  +"&return="+escape(ret)
                    296:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
1.5       www       297:                  "height=350,width=350,scrollbars=no,menubar=no");
                    298: 
                    299:     }
1.13    ! www       300: 
        !           301:     function psub() {
        !           302:         pclose();
        !           303:         if ((document.parmform.pres_value.value!='') && 
        !           304:             (document.parmform.pres_marker.value!='')) {
        !           305:             document.parmform.submit();
        !           306:         } else {
        !           307:             document.parmform.pres_value.value='';
        !           308:             document.parmform.pres_marker.value='';
        !           309:         }
        !           310:     }
        !           311: 
1.5       www       312: </script>
                    313: </head>
                    314: <body bgcolor="#FFFFFF" onUnload="pclose()">
                    315: <h1>Set Assessment Parameters</h1>
1.8       www       316: <form method="post" action="/adm/parmset" name="parmform">
                    317: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
                    318: <b>
                    319: Section/Group: 
1.12      www       320: <input type="text" value="$csec" size="6" name="csec">
1.8       www       321: <br>
                    322: For User 
1.12      www       323: <input type="text" value="$uname" size="12" name="uname">
                    324: or ID
                    325: <input type="text" value="$id" size="12" name="id"> 
1.8       www       326: at Domain 
1.12      www       327: <input type="text" value="$udom" size="6" name="udom">
1.8       www       328: </b>
1.12      www       329: <input type="submit" value="Display">
1.13    ! www       330: <input type="hidden" value='' name="pres_value">
        !           331: <input type="hidden" value='' name="pres_type">
        !           332: <input type="hidden" value='' name="pres_marker">
1.5       www       333: ENDHEAD
1.12      www       334: 	
                    335:         $r->print($message.'<p>Sort list by ');
1.8       www       336: 	$r->print('<select name="fcat" onChange="this.form.submit();">');
                    337:         my $k;
                    338:         my @sopt=('map','Map','name','Problem Name','deadline','Deadline');
                    339:         for ($k=0;$k<$#sopt;$k=$k+2) {
                    340: 	    $r->print('<option value="'.$sopt[$k].'"');
                    341:             if ($fcat eq $sopt[$k]) { $r->print(' selected'); }
                    342:             $r->print('>'.$sopt[$k+1].'</option>');
                    343:         }
                    344:         $r->print('</select>');
1.10      www       345: # ----------------------------------------------------------------- Start Table
                    346:         my $coursespan=$csec?8:5;
1.9       www       347: 	 $r->print(<<ENDTABLEHEAD);
                    348: <p><table border=2>
1.11      www       349: <tr><td colspan=5></td>
1.10      www       350: <th colspan=$coursespan>Any User</th>
1.9       www       351: ENDTABLEHEAD
1.10      www       352:     if ($uname) {
                    353: 	$r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>");
                    354:     }
                    355:     $r->print(<<ENDTABLETWO);
1.11      www       356: <th rowspan=3>Parameter in Effect</th></tr><tr><td colspan=5></td>
1.10      www       357: <th colspan=2>Resource Level</th>
                    358: <th colspan=3>in Course</th>
                    359: ENDTABLETWO
1.9       www       360:     if ($csec) {
1.10      www       361: 	$r->print("<th colspan=3>in Section/Group $csec</th>");
1.9       www       362:     }
1.10      www       363:     $r->print(<<ENDTABLEHEADFOUR);
1.11      www       364: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
1.10      www       365: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
1.11      www       366: <th>default</th><th>from Enclosing Map</th>
1.10      www       367: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
                    368: ENDTABLEHEADFOUR
                    369:     if ($csec) {
                    370:   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
                    371:     }
                    372:     if ($uname) {
                    373:   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
                    374:     }
                    375: 	$r->print('</tr><tr>');
1.3       www       376:  	 map {
1.4       www       377: # ------------------------------------------------------ Entry for one resource
1.8       www       378: 	    @outpar=();
1.5       www       379:             my $rid=$_;
                    380:             my $thistitle='';
1.11      www       381:             my %name=   ('0_deadline' => 'deadline');
                    382:             my %part=   ('0_deadline' => '0');
                    383: 	    my %display=('0_deadline' => 'Deadline');
                    384: 	    my %type=   ('0_deadline' => 'date_end');
                    385:             my %default=('0_deadline' => time);
1.4       www       386:             my %metadata=&Apache::lonmeta::unpackagemeta(
1.5       www       387: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
1.4       www       388:             map {
1.5       www       389:                 if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
1.11      www       390:                     my $hashid=$1.'_'.$2;
                    391: 		    $part{$hashid}=$1;
                    392:                     $name{$hashid}=$2;
                    393:                     my $tdef;
                    394:                     ($tdef,$display{$hashid})=
1.5       www       395: 			split(/\_\_dis\_\_/,$metadata{$_});
1.11      www       396: 		    ($type{$hashid},$default{$hashid})=split(/\:/,$tdef);
                    397:                     unless ($display{$hashid}) {
                    398:                         $display{$hashid}=$name{$hashid};
1.5       www       399:                     }
                    400:                 }
                    401:                 if ($_ eq 'title') {
                    402: 		    $thistitle=$metadata{$_};
1.4       www       403:                 }
                    404:             } keys %metadata;
1.11      www       405: 	    my $totalparms=scalar keys %name;
1.5       www       406:             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
1.10      www       407:   join(' / ',split(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))).
                    408:            '</font></tt><p><b>'.
1.5       www       409:                       $bighash{'title_'.$rid});
                    410:             if ($thistitle) {
                    411: 		$r->print(' ('.$thistitle.')');
                    412:             }
1.11      www       413:             $r->print('</b></td>');
                    414:             $r->print('<td rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
                    415:             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
1.10      www       416: 		      join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
1.11      www       417:             map {
                    418: 
                    419: 	       my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
                    420: 
                    421:                $r->print("<td>$part{$_}</td><td>$display{$_}</td>"); 
1.12      www       422:                my $mprefix=$rid.'&'.$_.'&';
1.13    ! www       423: 
1.12      www       424:                $r->print('<td'.(($result==11)?' bgcolor="#AAFFAA"':'').'>'.
                    425:              &valout($outpar[11],$type{$_}).'</td>');
                    426:                $r->print('<td'.(($result==10)?' bgcolor="#AAFFAA"':'').'>'.
                    427:              &valout($outpar[10],$type{$_}).'</td>');
1.13    ! www       428: 
1.12      www       429:                $r->print('<td'.(($result==9)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       430:              &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
        !           431:                     'parmform.pres','psub').'</td>');
1.12      www       432:                $r->print('<td'.(($result==8)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       433:              &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
        !           434:                     'parmform.pres','psub').'</td>');
1.12      www       435:                $r->print('<td'.(($result==7)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       436:              &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
        !           437:                     'parmform.pres','psub').'</td>');
        !           438: 
1.9       www       439:                if ($csec) {
1.12      www       440:                  $r->print('<td'.(($result==6)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       441:              &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
        !           442:                     'parmform.pres','psub').'</td>');
1.12      www       443:                  $r->print('<td'.(($result==5)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       444:              &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
        !           445:                     'parmform.pres','psub').'</td>');
1.12      www       446:                  $r->print('<td'.(($result==4)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       447:              &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
        !           448:                     'parmform.pres','psub').'</td>');
1.9       www       449:                }
1.13    ! www       450: 
1.9       www       451:                if ($uname) {
1.12      www       452:                  $r->print('<td'.(($result==3)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       453:              &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
        !           454:                     'parmform.pres','psub').'</td>');
1.12      www       455:                  $r->print('<td'.(($result==2)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       456:              &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
        !           457:                     'parmform.pres','psub').'</td>');
1.12      www       458:                  $r->print('<td'.(($result==1)?' bgcolor="#AAFFAA"':'').'>'.
1.13    ! www       459:              &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
        !           460:                     'parmform.pres','psub').'</td>');
1.9       www       461:                }
1.13    ! www       462: 
1.11      www       463:                $r->print('<td>'.&valout($outpar[$result],$type{$_}).'</td>');
1.5       www       464:                $r->print("</tr>\n<tr>");
1.11      www       465: 	   } sort keys %name;
1.4       www       466: # -------------------------------------------------- End entry for one resource
1.3       www       467: 	 } @ids;
1.8       www       468:          $r->print('</table></form></body></html>');
1.1       www       469:          untie(%bighash);
1.2       www       470: 	 untie(%parmhash);
1.1       www       471:       }
                    472:    } else {
                    473: # ----------------------------- Not in a course, or not allowed to modify parms
                    474:       $ENV{'user.error.msg'}=
1.7       www       475:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
1.1       www       476:       return HTTP_NOT_ACCEPTABLE; 
                    477:    }
                    478:    return OK;
                    479: }
                    480: 
                    481: 1;
                    482: __END__
                    483: 
                    484: 
                    485: 
                    486: 

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