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

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.5     ! www        12: # 11/20,11/21,11/22,11/23 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.3       www        28: my @ids;
                     29: my %symbp;
                     30: my %typep;
1.2       www        31: 
                     32: my $uname;
                     33: my $udom;
                     34: my $uhome;
                     35: 
                     36: my $csec;
                     37: 
1.3       www        38: my $fcat;
                     39: 
1.2       www        40: # -------------------------------------------- Figure out a cascading parameter
                     41: 
                     42: sub parmval {
1.3       www        43:     my ($what,$id)=@_;
1.2       www        44: # ----------------------------------------------------- Cascading lookup scheme
1.3       www        45:        my $symbparm=$symbp{$id}.'.'.$what;
1.2       www        46:        my $reslevel=
                     47: 	    $ENV{'request.course.id'}.'.'.$symbparm;
                     48:        my $seclevel=
                     49:             $ENV{'request.course.id'}.'.'.
                     50: 		$ENV{'request.course.sec'}.'.'.$what;
                     51:        my $courselevel=
                     52:             $ENV{'request.course.id'}.'.'.$what;
                     53: 
                     54: # ----------------------------------------------------------- first, check user
                     55: 
1.3       www        56:       if ($uname) {
1.2       www        57:        if ($useropt{$reslevel}) { return $useropt{$reslevel}; }
                     58:        if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
                     59:        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
1.3       www        60:       }
1.2       www        61: 
                     62: # -------------------------------------------------------- second, check course
                     63: 
                     64:        if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }
                     65:        if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }  
                     66:        if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
                     67: 
                     68: # ------------------------------------------------------ third, check map parms
                     69: 
                     70:        my $thisparm=$parmhash{$symbparm};
                     71:        if ($thisparm) { return $thisparm; }
                     72:      
                     73: # --------------------------------------------- last, look in resource metadata
                     74: 
1.3       www        75:         my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
1.2       www        76:         if (-e $filename) {
                     77:             my @content;
                     78:             {
                     79:              my $fh=Apache::File->new($filename);
                     80:              @content=<$fh>;
                     81:             }
                     82:             if (join('',@content)=~
                     83:                  /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {
                     84: 	        return $1;
                     85:  	    }
                     86:         }
                     87:     return '';
                     88: }
                     89: 
1.3       www        90: # ---------------------------------------------------------------- Sort routine
                     91: 
                     92: sub bycat {
                     93:     if ($fcat eq '') {
                     94:         $a<=>$b;
                     95:     } else {
                     96:         &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);
                     97:     }
                     98: }
                     99: 
1.5     ! www       100: # -------------------------------------------------------- Produces link anchor
        !           101: 
        !           102: sub plink {
        !           103:     my ($type,$dis,$value,$marker,$return,$call)=@_;
        !           104:     return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"
        !           105:            .$marker."','".$return."','".$call."'".');">'.
        !           106:            (($type=~/^date/)?localtime($value):$value).'</a>';
        !           107: }
        !           108: 
1.1       www       109: # ================================================================ Main Handler
                    110: 
                    111: sub handler {
                    112:    my $r=shift;
                    113: 
                    114:    if ($r->header_only) {
                    115:       $r->content_type('text/html');
                    116:       $r->send_http_header;
                    117:       return OK;
                    118:    }
                    119: 
                    120: # ----------------------------------------------------- Needs to be in a course
                    121: 
                    122:    if (($ENV{'request.course.fn'}) && 
                    123:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.2       www       124: # -------------------------------------------------------- Variable declaration
                    125: 
                    126:       %courseopt=();
                    127:       %useropt=();
                    128:       %bighash=();
                    129: 
1.3       www       130:       @ids=();
                    131:       %symbp=();
                    132:       %typep=();
1.2       www       133: 
                    134:       $uname=$ENV{'form.uname'};
                    135:       $udom=$ENV{'form.udom'};
                    136:       unless ($udom) { $uname=''; }
                    137:       $uhome='';
1.3       www       138:       my $message='';
1.2       www       139:       if ($uname) {
                    140: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
                    141:       }
1.3       www       142:       if ($uhome eq 'no_host') { 
                    143:           $message=
                    144:          "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
                    145:           $uname=''; 
                    146:       }
1.2       www       147: 
                    148:       $csec=$ENV{'form.csec'};
1.3       www       149:       unless ($csec) { $csec=''; }
                    150:       $fcat=$ENV{'form.fcat'};
                    151:       unless ($fcat) { $fcat=''; }
1.2       www       152: 
                    153: # ------------------------------------------------------------------- Tie hashs
                    154:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
                    155:                        &GDBM_READER,0640)) &&
                    156:           (tie(%parmhash,'GDBM_File',
                    157:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
                    158: 
                    159: # -------------------------------------------------------------- Get coursedata
                    160:         my $reply=&Apache::lonnet::reply('dump:'.
                    161:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
                    162:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
                    163:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
                    164:         if ($reply!~/^error\:/) {
                    165:            map {
                    166:              my ($name,$value)=split(/\=/,$_);
                    167:              $courseopt{unescape($name)}=unescape($value);  
                    168:            } split(/\&/,$reply);
                    169:         }
                    170: # --------------------------------------------------- Get userdata (if present)
                    171:         if ($uname) {
                    172:            my $reply=
                    173:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
                    174:            if ($reply!~/^error\:/) {
                    175:               map {
                    176:                 my ($name,$value)=split(/\=/,$_);
                    177:                 $useropt{unescape($name)}=unescape($value);  
                    178:               } split(/\&/,$reply);
                    179:            }
                    180:         }
                    181: # --------------------------------------------------------- Get all assessments
                    182:         map {
                    183: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
                    184: 	       my $mapid=$1;
                    185:                my $resid=$2;
1.3       www       186:                my $id=$mapid.'.'.$resid;
1.2       www       187:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3       www       188: 		   $ids[$#ids+1]=$id;
                    189:                    $typep{$id}=$1;
                    190:                    $symbp{$id}=
1.2       www       191: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1.3       www       192: 			'___'.$resid.'___'.
                    193: 			    &Apache::lonnet::declutter($bighash{$_});
1.2       www       194: 	       }
                    195:             }
                    196:         } keys %bighash;
                    197: # ------------------------------------------------------------------- Sort this
1.3       www       198:          @ids=sort bycat @ids;
1.2       www       199: # ------------------------------------------------------------------ Start page
1.1       www       200:          $r->content_type('text/html');
                    201:          $r->send_http_header;
1.5     ! www       202: 	$r->print(<<ENDHEAD);
        !           203: <html>
        !           204: <head>
        !           205: <title>LON-CAPA Assessment Parameters</title>
        !           206: <script>
        !           207:     function pclose() {
        !           208:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
        !           209:                  "height=350,width=350,scrollbars=no,menubar=no");
        !           210:         parmwin.close();
        !           211:     }
        !           212: 
        !           213:     function pjump(type,dis,value,marker,ret,call) {
        !           214:         parmwin=window.open("/adm/rat/parameter.html?type="+type
        !           215:                  +"&value="+value+"&marker="+marker+"&return="+ret
        !           216:                  +"&call="+call+"&name="+dis,"LONCAPAparms",
        !           217:                  "height=350,width=350,scrollbars=no,menubar=no");
        !           218: 
        !           219:     }
        !           220: </script>
        !           221: </head>
        !           222: <body bgcolor="#FFFFFF" onUnload="pclose()">
        !           223: <h1>Set Assessment Parameters</h1>
        !           224: ENDHEAD
1.3       www       225: 	$r->print("<h2>Course: $ENV{'course.'.
                    226:                    $ENV{'request.course.id'}.'.description'}</h2>");
                    227: 	 if ($csec) {
                    228:             $r->print("<h3>Section/Group: $csec</h3>");
                    229: 	 }
                    230: 	 if ($uname) {
                    231:             $r->print("<h3>For User $uname at Domain $udom");
                    232: 	 }
                    233: 	 if ($uhome eq 'no_host') {
                    234:             $r->print($message);
                    235:          }
1.5     ! www       236: 	 $r->print("\n<table border=2>\n<tr>");
1.3       www       237:  	 map {
1.4       www       238: # ------------------------------------------------------ Entry for one resource
1.5     ! www       239:             my $rid=$_;
        !           240:             my $thistitle='';
        !           241:             my @part=(0,1,1);
        !           242:             my @name=('deadline','sig','tol');
        !           243: 	    my @display=('Deadline','Significant Figures','Tolerance');
        !           244: 	    my @type=('date','int','tolerance');
1.4       www       245:             my %metadata=&Apache::lonmeta::unpackagemeta(
1.5     ! www       246: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
1.4       www       247:             map {
1.5     ! www       248:                 if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
        !           249: 		    $part[$#part+1]=$1;
        !           250:                     $name[$#name+1]=$2;
        !           251:                     ($type[$#type+1],$display[$#display+1])=
        !           252: 			split(/\_\_dis\_\_/,$metadata{$_});
        !           253:                     unless ($display[$#display]) {
        !           254:                         $display[$#display]=$name[$#name];
        !           255:                     }
        !           256:                 }
        !           257:                 if ($_ eq 'title') {
        !           258: 		    $thistitle=$metadata{$_};
1.4       www       259:                 }
                    260:             } keys %metadata;
1.5     ! www       261:             my $totalparms=$#name+1;
        !           262:             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
        !           263:                 $bighash{'src_'.$rid}.'</font></tt><p><b>'.
        !           264:                       $bighash{'title_'.$rid});
        !           265:             if ($thistitle) {
        !           266: 		$r->print(' ('.$thistitle.')');
        !           267:             }
        !           268:             $r->print('</b></td>');
        !           269:             my $i;
        !           270:             for ($i=0;$i<$totalparms;$i++) {
        !           271:                $r->print("<td>$part[$i]</td><td>$display[$i]</td>");
        !           272:                $r->print('<td>'.&plink($type[$i],$display[$i],'987684455').'</td>');
        !           273:                $r->print("</tr>\n<tr>");
        !           274: 	   }
1.4       www       275: # -------------------------------------------------- End entry for one resource
1.3       www       276: 	 } @ids;
1.4       www       277:          $r->print('</table></body></html>');
1.1       www       278:          untie(%bighash);
1.2       www       279: 	 untie(%parmhash);
1.1       www       280:       }
                    281:    } else {
                    282: # ----------------------------- Not in a course, or not allowed to modify parms
                    283:       $ENV{'user.error.msg'}=
                    284:         "/adm/flip:opa:0:0:Cannot modify assessment parameters";
                    285:       return HTTP_NOT_ACCEPTABLE; 
                    286:    }
                    287:    return OK;
                    288: }
                    289: 
                    290: 1;
                    291: __END__
                    292: 
                    293: 
                    294: 
                    295: 
                    296: 
                    297: 
                    298: 

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