Return to lonparmset.pm CVS log

Up to [LON-CAPA] / loncom / interface

Bugfix for "not acceptable" re-route to roles handler

    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: #
   12: # 11/20,11/21,11/22,11/23 Gerd Kortemeyer
   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;
   20: use Apache::lonmeta;
   21: 
   22: 
   23: my %courseopt;
   24: my %useropt;
   25: my %bighash;
   26: my %parmhash;
   27: 
   28: my @ids;
   29: my %symbp;
   30: my %typep;
   31: 
   32: my $uname;
   33: my $udom;
   34: my $uhome;
   35: 
   36: my $csec;
   37: 
   38: my $fcat;
   39: 
   40: # -------------------------------------------- Figure out a cascading parameter
   41: 
   42: sub parmval {
   43:     my ($what,$id)=@_;
   44: # ----------------------------------------------------- Cascading lookup scheme
   45:        my $symbparm=$symbp{$id}.'.'.$what;
   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: 
   56:       if ($uname) {
   57:        if ($useropt{$reslevel}) { return $useropt{$reslevel}; }
   58:        if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
   59:        if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
   60:       }
   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: 
   75:         my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
   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: 
   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: 
  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: 
  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'}))) {
  124: # -------------------------------------------------------- Variable declaration
  125: 
  126:       %courseopt=();
  127:       %useropt=();
  128:       %bighash=();
  129: 
  130:       @ids=();
  131:       %symbp=();
  132:       %typep=();
  133: 
  134:       $uname=$ENV{'form.uname'};
  135:       $udom=$ENV{'form.udom'};
  136:       unless ($udom) { $uname=''; }
  137:       $uhome='';
  138:       my $message='';
  139:       if ($uname) {
  140: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
  141:       }
  142:       if ($uhome eq 'no_host') { 
  143:           $message=
  144:          "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
  145:           $uname=''; 
  146:       }
  147: 
  148:       $csec=$ENV{'form.csec'};
  149:       unless ($csec) { $csec=''; }
  150:       $fcat=$ENV{'form.fcat'};
  151:       unless ($fcat) { $fcat=''; }
  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;
  186:                my $id=$mapid.'.'.$resid;
  187:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  188: 		   $ids[$#ids+1]=$id;
  189:                    $typep{$id}=$1;
  190:                    $symbp{$id}=
  191: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
  192: 			'___'.$resid.'___'.
  193: 			    &Apache::lonnet::declutter($bighash{$_});
  194: 	       }
  195:             }
  196:         } keys %bighash;
  197: # ------------------------------------------------------------------- Sort this
  198:          @ids=sort bycat @ids;
  199: # ------------------------------------------------------------------ Start page
  200:          $r->content_type('text/html');
  201:          $r->send_http_header;
  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="+escape(type)
  215:                  +"&value="+escape(value)+"&marker="+escape(marker)
  216:                  +"&return="+escape(ret)
  217:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
  218:                  "height=350,width=350,scrollbars=no,menubar=no");
  219: 
  220:     }
  221: </script>
  222: </head>
  223: <body bgcolor="#FFFFFF" onUnload="pclose()">
  224: <h1>Set Assessment Parameters</h1>
  225: ENDHEAD
  226: 	$r->print("<h2>Course: $ENV{'course.'.
  227:                    $ENV{'request.course.id'}.'.description'}</h2>");
  228: 	 if ($csec) {
  229:             $r->print("<h3>Section/Group: $csec</h3>");
  230: 	 }
  231: 	 if ($uname) {
  232:             $r->print("<h3>For User $uname at Domain $udom");
  233: 	 }
  234: 	 if ($uhome eq 'no_host') {
  235:             $r->print($message);
  236:          }
  237: 	 $r->print("\n<table border=2>\n<tr>");
  238:  	 map {
  239: # ------------------------------------------------------ Entry for one resource
  240:             my $rid=$_;
  241:             my $thistitle='';
  242:             my @part=(0,1,1);
  243:             my @name=('deadline','sig','tol');
  244: 	    my @display=('Deadline','Significant Figures','Tolerance');
  245: 	    my @type=('date','int','tolerance');
  246:             my %metadata=&Apache::lonmeta::unpackagemeta(
  247: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
  248:             map {
  249:                 if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
  250: 		    $part[$#part+1]=$1;
  251:                     $name[$#name+1]=$2;
  252:                     ($type[$#type+1],$display[$#display+1])=
  253: 			split(/\_\_dis\_\_/,$metadata{$_});
  254:                     unless ($display[$#display]) {
  255:                         $display[$#display]=$name[$#name];
  256:                     }
  257:                 }
  258:                 if ($_ eq 'title') {
  259: 		    $thistitle=$metadata{$_};
  260:                 }
  261:             } keys %metadata;
  262:             my $totalparms=$#name+1;
  263:             $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
  264:                 $bighash{'src_'.$rid}.'</font></tt><p><b>'.
  265:                       $bighash{'title_'.$rid});
  266:             if ($thistitle) {
  267: 		$r->print(' ('.$thistitle.')');
  268:             }
  269:             $r->print('</b></td>');
  270:             my $i;
  271:             for ($i=0;$i<$totalparms;$i++) {
  272:                $r->print("<td>$part[$i]</td><td>$display[$i]</td>");
  273:                $r->print('<td>'.&plink($type[$i],$display[$i],'987684455').'</td>');
  274:                $r->print("</tr>\n<tr>");
  275: 	   }
  276: # -------------------------------------------------- End entry for one resource
  277: 	 } @ids;
  278:          $r->print('</table></body></html>');
  279:          untie(%bighash);
  280: 	 untie(%parmhash);
  281:       }
  282:    } else {
  283: # ----------------------------- Not in a course, or not allowed to modify parms
  284:       $ENV{'user.error.msg'}=
  285:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
  286:       return HTTP_NOT_ACCEPTABLE; 
  287:    }
  288:    return OK;
  289: }
  290: 
  291: 1;
  292: __END__
  293: 
  294: 
  295: 
  296: 
  297: 
  298: 
  299: