Return to lonparmset.pm CVS log

Up to [LON-CAPA] / loncom / interface

Reads metadata to find out which parameters to set

    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 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: # ================================================================ Main Handler
  101: 
  102: sub handler {
  103:    my $r=shift;
  104: 
  105:    if ($r->header_only) {
  106:       $r->content_type('text/html');
  107:       $r->send_http_header;
  108:       return OK;
  109:    }
  110: 
  111: # ----------------------------------------------------- Needs to be in a course
  112: 
  113:    if (($ENV{'request.course.fn'}) && 
  114:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
  115: # -------------------------------------------------------- Variable declaration
  116: 
  117:       %courseopt=();
  118:       %useropt=();
  119:       %bighash=();
  120: 
  121:       @ids=();
  122:       %symbp=();
  123:       %typep=();
  124: 
  125:       $uname=$ENV{'form.uname'};
  126:       $udom=$ENV{'form.udom'};
  127:       unless ($udom) { $uname=''; }
  128:       $uhome='';
  129:       my $message='';
  130:       if ($uname) {
  131: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
  132:       }
  133:       if ($uhome eq 'no_host') { 
  134:           $message=
  135:          "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
  136:           $uname=''; 
  137:       }
  138: 
  139:       $csec=$ENV{'form.csec'};
  140:       unless ($csec) { $csec=''; }
  141:       $fcat=$ENV{'form.fcat'};
  142:       unless ($fcat) { $fcat=''; }
  143: 
  144: # ------------------------------------------------------------------- Tie hashs
  145:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  146:                        &GDBM_READER,0640)) &&
  147:           (tie(%parmhash,'GDBM_File',
  148:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
  149: 
  150: # -------------------------------------------------------------- Get coursedata
  151:         my $reply=&Apache::lonnet::reply('dump:'.
  152:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
  153:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
  154:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  155:         if ($reply!~/^error\:/) {
  156:            map {
  157:              my ($name,$value)=split(/\=/,$_);
  158:              $courseopt{unescape($name)}=unescape($value);  
  159:            } split(/\&/,$reply);
  160:         }
  161: # --------------------------------------------------- Get userdata (if present)
  162:         if ($uname) {
  163:            my $reply=
  164:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
  165:            if ($reply!~/^error\:/) {
  166:               map {
  167:                 my ($name,$value)=split(/\=/,$_);
  168:                 $useropt{unescape($name)}=unescape($value);  
  169:               } split(/\&/,$reply);
  170:            }
  171:         }
  172: # --------------------------------------------------------- Get all assessments
  173:         map {
  174: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
  175: 	       my $mapid=$1;
  176:                my $resid=$2;
  177:                my $id=$mapid.'.'.$resid;
  178:                if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  179: 		   $ids[$#ids+1]=$id;
  180:                    $typep{$id}=$1;
  181:                    $symbp{$id}=
  182: 		    &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
  183: 			'___'.$resid.'___'.
  184: 			    &Apache::lonnet::declutter($bighash{$_});
  185: 	       }
  186:             }
  187:         } keys %bighash;
  188: # ------------------------------------------------------------------- Sort this
  189:          @ids=sort bycat @ids;
  190: # ------------------------------------------------------------------ Start page
  191:          $r->content_type('text/html');
  192:          $r->send_http_header;
  193: 	 $r->print(
  194:   '<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');
  195: 	$r->print("<h2>Course: $ENV{'course.'.
  196:                    $ENV{'request.course.id'}.'.description'}</h2>");
  197: 	 if ($csec) {
  198:             $r->print("<h3>Section/Group: $csec</h3>");
  199: 	 }
  200: 	 if ($uname) {
  201:             $r->print("<h3>For User $uname at Domain $udom");
  202: 	 }
  203: 	 if ($uhome eq 'no_host') {
  204:             $r->print($message);
  205:          }
  206: 	 $r->print('<table border=2>');
  207:  	 map {
  208: 	    $r->print('<tr>');
  209: # ------------------------------------------------------ Entry for one resource
  210:             my %metadata=&Apache::lonmeta::unpackagemeta(
  211:   &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$_}.'.meta'),1);
  212:             map {
  213:                 if ($_=~/^parameter\_(\d+)\_(\w+)\_\_dis\_\_(.+)$/) {
  214: 		    my $part=$1;
  215:                     my $name=$2;
  216:                     my $display=$3;
  217:                     my $type=$metadata{$_};
  218:                 }
  219:             } keys %metadata;
  220: # -------------------------------------------------- End entry for one resource
  221:             $r->print('</tr>');
  222: 	 } @ids;
  223:          $r->print('</table></body></html>');
  224:          untie(%bighash);
  225: 	 untie(%parmhash);
  226:       }
  227:    } else {
  228: # ----------------------------- Not in a course, or not allowed to modify parms
  229:       $ENV{'user.error.msg'}=
  230:         "/adm/flip:opa:0:0:Cannot modify assessment parameters";
  231:       return HTTP_NOT_ACCEPTABLE; 
  232:    }
  233:    return OK;
  234: }
  235: 
  236: 1;
  237: __END__
  238: 
  239: 
  240: 
  241: 
  242: 
  243: 
  244: